diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of git.dcc.fc.up.pt:yap-6.3

Browse Source
This commit is contained in:
Ubuntu32
2011-11-08 00:17:54 -08:00
parent 29dc250a66 64dded4a53
commit e1b132325e
57 changed files with 4333 additions and 655 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
C/absmi.c
View File

@@ -2267,23 +2267,6 @@ Yap_absmi(int inp)
prune((choiceptr)YREG[E_CB]);
setregs();
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
if (ENV > (CELL *) top_b || ENV < H) YREG = (CELL *) top_b;
#else
if (ENV > (CELL *) top_b) YREG = (CELL *) top_b;
#endif /* YAPOR_SBA */
else YREG = (CELL *)((CELL)ENV + ENV_Size(CPREG));
}
#else
if (ENV > (CELL *)B) {
YREG = (CELL *)B;
} else {
YREG = (CELL *) ((CELL) ENV + ENV_Size(CPREG));
}
#endif
GONext();
ENDOp();

2
C/adtdefs.c
View File

@@ -115,7 +115,7 @@ SearchInInvisible(char *atom)
READ_LOCK(INVISIBLECHAIN.AERWLock);
chain = RepAtom(INVISIBLECHAIN.Entry);
while (!EndOfPAEntr(chain) && strcmp(chain->StrOfAE, atom) != 0) {
while (!EndOfPAEntr(chain) && strcmp(chain->StrOfAE, atom)) {
chain = RepAtom(chain->NextOfAE);
}
READ_UNLOCK(INVISIBLECHAIN.AERWLock);

121
C/c_interface.c
View File

@@ -384,12 +384,14 @@ X_API Bool STD_PROTO(YAP_IsNonVarTerm,(Term));
X_API Bool STD_PROTO(YAP_IsIntTerm,(Term));
X_API Bool STD_PROTO(YAP_IsLongIntTerm,(Term));
X_API Bool STD_PROTO(YAP_IsBigNumTerm,(Term));
X_API Bool STD_PROTO(YAP_IsNumberTerm,(Term));
X_API Bool STD_PROTO(YAP_IsRationalTerm,(Term));
X_API Bool STD_PROTO(YAP_IsFloatTerm,(Term));
X_API Bool STD_PROTO(YAP_IsDbRefTerm,(Term));
X_API Bool STD_PROTO(YAP_IsAtomTerm,(Term));
X_API Bool STD_PROTO(YAP_IsPairTerm,(Term));
X_API Bool STD_PROTO(YAP_IsApplTerm,(Term));
X_API Bool STD_PROTO(YAP_IsCompoundTerm,(Term));
X_API Bool STD_PROTO(YAP_IsExternalDataInStackTerm,(Term));
X_API Bool STD_PROTO(YAP_IsOpaqueObjectTerm,(Term, int));
X_API Term STD_PROTO(YAP_MkIntTerm,(Int));
@@ -425,7 +427,9 @@ X_API Int STD_PROTO(YAP_ArityOfFunctor,(Functor));
X_API void *STD_PROTO(YAP_ExtraSpace,(void));
X_API void STD_PROTO(YAP_cut_up,(void));
X_API Int STD_PROTO(YAP_Unify,(Term,Term));
X_API int STD_PROTO(YAP_Unifiable,(Term,Term));
X_API int STD_PROTO(YAP_Reset,(void));
X_API Int STD_PROTO(YAP_ListLength,(Term));
X_API Int STD_PROTO(YAP_Init,(YAP_init_args *));
X_API Int STD_PROTO(YAP_FastInit,(char *));
X_API PredEntry *STD_PROTO(YAP_FunctorToPred,(Functor));
@@ -513,6 +517,7 @@ X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int));
X_API Term STD_PROTO(YAP_MkBlobTerm,(unsigned int));
X_API void *STD_PROTO(YAP_BlobOfTerm,(Term));
X_API Term STD_PROTO(YAP_TermNil,(void));
X_API int STD_PROTO(YAP_IsTermNil,(Term));
X_API int STD_PROTO(YAP_AtomGetHold,(Atom));
X_API int STD_PROTO(YAP_AtomReleaseHold,(Atom));
X_API Agc_hook STD_PROTO(YAP_AGCRegisterHook,(Agc_hook));
@@ -529,6 +534,9 @@ X_API void *STD_PROTO(YAP_Record,(Term));
X_API Term STD_PROTO(YAP_Recorded,(void *));
X_API int STD_PROTO(YAP_Erase,(void *));
X_API int STD_PROTO(YAP_Variant,(Term, Term));
X_API Int STD_PROTO(YAP_NumberVars,(Term, Int));
X_API Term STD_PROTO(YAP_UnNumberVars,(Term));
X_API int STD_PROTO(YAP_IsNumberedVariable,(Term));
X_API int STD_PROTO(YAP_ExactlyEqual,(Term, Term));
X_API Int STD_PROTO(YAP_TermHash,(Term, Int, Int, int));
X_API void STD_PROTO(YAP_signal,(int));
@@ -544,6 +552,7 @@ X_API int STD_PROTO(YAP_NewOpaqueType,(void *));
X_API Term STD_PROTO(YAP_NewOpaqueObject,(int, size_t));
X_API void *STD_PROTO(YAP_OpaqueObjectFromTerm,(Term));
X_API int STD_PROTO(YAP_Argv,(char *** argvp));
X_API YAP_tag_t STD_PROTO(YAP_TagOfTerm,(Term));
static int
dogc( USES_REGS1 )
@@ -600,6 +609,12 @@ YAP_IsIntTerm(Term t)
return IsIntegerTerm(t);
}
X_API Bool
YAP_IsNumberTerm(Term t)
{
return IsIntegerTerm(t) || IsIntTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t);
}
X_API Bool
YAP_IsLongIntTerm(Term t)
{
@@ -680,6 +695,13 @@ YAP_IsApplTerm(Term t)
return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t)));
}
X_API Bool
YAP_IsCompoundTerm(Term t)
{
return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) ||
IsPairTerm(t);
}
X_API Term
YAP_MkIntTerm(Int n)
@@ -1179,6 +1201,18 @@ YAP_Unify(Term t1, Term t2)
return out;
}
X_API int
YAP_Unifiable(Term t1, Term t2)
{
int out;
BACKUP_MACHINE_REGS();
out = Yap_Unifiable(t1, t2);
RECOVER_MACHINE_REGS();
return out;
}
/* == */
X_API int
YAP_ExactlyEqual(Term t1, Term t2)
@@ -3416,6 +3450,12 @@ YAP_TermNil(void)
return TermNil;
}
X_API int
YAP_IsTermNil(Term t)
{
return t == TermNil;
}
X_API int
YAP_AtomGetHold(Atom at)
{
@@ -3781,7 +3821,6 @@ YAP_OpInfo(Atom at, Term module, int opkind, int *yap_type, int *prio)
return 1;
}
int
YAP_Argv(char ***argvp)
{
@@ -3790,3 +3829,83 @@ YAP_Argv(char ***argvp)
}
return GLOBAL_argc;
}
YAP_tag_t
YAP_TagOfTerm(Term t)
{
if (IsVarTerm(t)) {
CELL *pt = VarOfTerm(t);
if (IsUnboundVar(pt)) {
if (IsAttVar(pt))
return YAP_TAG_ATT;
return YAP_TAG_UNBOUND;
}
return YAP_TAG_REF;
}
if (IsPairTerm(t))
return YAP_TAG_PAIR;
if (IsAtomOrIntTerm(t)) {
if (IsAtomTerm(t))
return YAP_TAG_ATOM;
return YAP_TAG_INT;
} else {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
return YAP_TAG_DBREF;
}
if (f == FunctorLongInt) {
return YAP_TAG_LONG_INT;
}
if (f == FunctorBigInt) {
big_blob_type bt = RepAppl(t)[1];
switch (bt) {
case BIG_INT:
return YAP_TAG_BIG_INT;
case BIG_RATIONAL:
return YAP_TAG_RATIONAL;
default:
return YAP_TAG_OPAQUE;
}
}
}
return YAP_TAG_APPL;
}
}
int YAP_BPROLOG_exception;
Term YAP_BPROLOG_curr_toam_status;
Int
YAP_ListLength(Term t) {
Int l = 0;
while (TRUE) {
if (IsVarTerm(t)) return -1;
if (t == TermNil)
return l;
if (!IsPairTerm(t))
return -1;
l++;
t = TailOfTerm(t);
}
}
Int
YAP_NumberVars(Term t, Int nbv) {
return Yap_NumberVars(t, nbv);
}
Term
YAP_UnNumberVars(Term t) {
/* don't allow sharing of ground terms */
return Yap_UnNumberTerm(t, FALSE);
}
int
YAP_IsNumberedVariable(Term t) {
return IsApplTerm(t) &&
FunctorOfTerm(t) == FunctorVar &&
IsIntegerTerm(ArgOfTerm(1,t));
}

7
C/cmppreds.c
View File

@@ -317,8 +317,9 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
return 1;
return -1;
} else {
if (IsIntTerm(t2))
if (IsIntTerm(t2)) {
return IntOfTerm(t1) - IntOfTerm(t2);
}
if (IsFloatTerm(t2)) {
return 1;
}
@@ -441,9 +442,9 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
}
}
int Yap_compare_terms(CELL d0, CELL d1)
Int Yap_compare_terms(Term d0, Term d1)
{
return (compare(Deref(d0),Deref(d1)));
return compare(Deref(d0),Deref(d1));
}
static Int

53
C/eval.c
View File

@@ -34,7 +34,54 @@ static char SccsId[] = "%W% %G%";
#include <unistd.h>
#endif
static Term Eval(Term t1 USES_REGS);
static Term
get_matrix_element(Term t1, Term t2 USES_REGS)
{
if (!IsPairTerm(t2)) {
if (t2 == MkAtomTerm(AtomLength)) {
Int sz = 1;
while (IsApplTerm(t1)) {
Functor f = FunctorOfTerm(t1);
if (NameOfFunctor(f) != AtomNil) {
return MkIntegerTerm(sz);
}
sz *= ArityOfFunctor(f);
t1 = ArgOfTerm(1, t1);
}
return MkIntegerTerm(sz);
}
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
return FALSE;
}
while (IsPairTerm(t2)) {
Int indx;
Term indxt = Eval(HeadOfTerm(t2) PASS_REGS);
if (!IsIntegerTerm(indxt)) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
return FALSE;
}
indx = IntegerOfTerm(indxt);
if (!IsApplTerm(t1)) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
return FALSE;
} else {
Functor f = FunctorOfTerm(t1);
if (ArityOfFunctor(f) < indx) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
return FALSE;
}
}
t1 = ArgOfTerm(indx, t1);
t2 = TailOfTerm(t2);
}
if (t2 != TermNil) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
return FALSE;
}
return Eval(t1 PASS_REGS);
}
static Term
Eval(Term t USES_REGS)
@@ -77,6 +124,12 @@ Eval(Term t USES_REGS)
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,n);
}
if (p->FOfEE == op_power && p->ArityOfEE == 2) {
t2 = ArgOfTerm(2, t);
if (IsPairTerm(t2)) {
return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS);
}
}
*RepAppl(t) = (CELL)AtomFoundVar;
t1 = Eval(ArgOfTerm(1,t) PASS_REGS);
if (t1 == 0L) {

5
C/init.c
View File

@@ -409,7 +409,10 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, UInt flags)
Functor f = NULL;
while (atom == NIL) {
atom = Yap_FullLookupAtom(Name);
if (flags & UserCPredFlag)
atom = Yap_LookupAtom(Name);
else
atom = Yap_FullLookupAtom(Name);
if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while initialising %s", Name);
return;

22
C/load_dl.c
View File

@@ -25,6 +25,28 @@
#include <string.h>
#include <stdio.h>
typedef void (*prismf)(void);
/* only works for dlls */
int
Yap_CallFunctionByName(const char *thing_string);
int
Yap_CallFunctionByName(const char *thing_string)
{
void * handle = dlopen(NULL, RTLD_LAZY | RTLD_NOLOAD);
// you could do RTLD_NOW as well. shouldn't matter
if (!handle) {
CACHE_REGS
Yap_Error(SYSTEM_ERROR, ARG1, "Dynamic linking on main module : %s\n", dlerror());
}
prismf * addr = (prismf *)dlsym(handle, thing_string);
fprintf(stderr, "%s is at %p\n", thing_string, addr);
if (addr)
(*addr)();
return TRUE;
}
/*
* YAP_FindExecutable(argv[0]) should be called on yap initialization to
* locate the executable of Yap

2
C/pl-yap.c
View File

@@ -619,7 +619,7 @@ currentOperator(Module m, atom_t name, int kind, int *type, int *priority)
int
numberVars(term_t t, nv_options *opts, int n ARG_LD) {
return 0;
return Yap_NumberVars(YAP_GetFromSlot(t), n);
}
/*******************************

4
C/sort.c
View File

@@ -267,14 +267,14 @@ Int compact_mergesort(CELL *pt, Int size, int my_p)
while (pt_left < end_pt_left && pt_right < end_pt_right) {
/* if the element to the left is larger than the one to the right */
Int cmp = Yap_compare_terms(pt_left[0], pt_right[0]);
if (cmp < 0) {
if (cmp < (Int)0) {
/* copy the one to the left */
pt[0] = pt_left[0];
/* and avance the two pointers */
pt += 2;
size ++;
pt_left += 2;
} else if (cmp == 0) {
} else if (cmp == (Int)0) {
/* otherwise, just skip one of them, anyone */
pt_left += 2;
} else {

60
C/unify.c
View File

@@ -605,11 +605,13 @@ InitReverseLookupOpcode(void)
}
#endif
#define UnifiableGlobalCells(a, b) \
if((a) > (b)) { \
Bind_Global_NonAtt((a),(CELL)(b)); \
} else if((a) < (b)){ \
Bind_Global_NonAtt((b),(CELL) (a)); \
#define UnifyAndTrailGlobalCells(a, b) \
if((a) > (b)) { \
*(a) = (CELL)(b); \
DO_TRAIL((a), (CELL)(b)); \
} else if((a) < (b)){ \
*(b) = (CELL)(a); \
DO_TRAIL((b), (CELL)(a)); \
}
static int
@@ -736,7 +738,8 @@ loop:
derefa_body(d1, ptd1, unifiable_comp_nvar_unk, unifiable_comp_nvar_nvar);
/* d1 and pt2 have the unbound value, whereas d0 is bound */
Bind(ptd1, d0);
*(ptd1) = d0;
DO_TRAIL(ptd1, d0);
continue;
}
@@ -752,12 +755,13 @@ loop:
deref_head(d1, unifiable_comp_var_unk);
unifiable_comp_var_nvar:
/* pt2 is unbound and d1 is bound */
Bind(ptd0, d1);
*ptd0 = d1;
DO_TRAIL(ptd0, d1);
continue;
derefa_body(d1, ptd1, unifiable_comp_var_unk, unifiable_comp_var_nvar);
/* ptd0 and ptd1 are unbound */
UnifiableGlobalCells(ptd0, ptd1);
UnifyAndTrailGlobalCells(ptd0, ptd1);
}
}
/* Do we still have compound terms to visit */
@@ -879,7 +883,8 @@ unifiable_nvar_nvar:
deref_body(d1, pt1, unifiable_nvar_unk, unifiable_nvar_nvar);
/* d0 is bound and d1 is unbound */
Bind(pt1, d0);
*(pt1) = d0;
DO_TRAIL(pt1, d0);
return (TRUE);
deref_body(d0, pt0, unifiable_unk, unifiable_nvar);
@@ -887,18 +892,13 @@ unifiable_nvar_nvar:
deref_head(d1, unifiable_var_unk);
unifiable_var_nvar:
/* pt0 is unbound and d1 is bound */
Bind(pt0, d1);
*pt0 = d1;
DO_TRAIL(pt0, d1);
return TRUE;
#if TRAILING_REQUIRES_BRANCH
unifiable_var_nvar_trail:
DO_TRAIL(pt0);
return TRUE;
#endif
deref_body(d1, pt1, unifiable_var_unk, unifiable_var_nvar);
/* d0 and pt1 are unbound */
UnifyCells(pt0, pt1);
UnifyAndTrailCells(pt0, pt1);
return (TRUE);
#if THREADS
#undef Yap_REGS
@@ -914,13 +914,13 @@ unifiable_var_nvar_trail:
static Int
p_unifiable( USES_REGS1 )
{
tr_fr_ptr trp;
tr_fr_ptr trp, trp0 = TR;
Term tf = TermNil;
if (!unifiable(ARG1,ARG2)) {
return FALSE;
}
trp = TR;
while (trp != B->cp_tr) {
while (trp != trp0) {
Term t[2];
--trp;
t[0] = TrailTerm(trp);
@@ -931,6 +931,26 @@ p_unifiable( USES_REGS1 )
return Yap_unify(ARG3, tf);
}
int
Yap_Unifiable( Term d0, Term d1 )
{
CACHE_REGS
tr_fr_ptr trp, trp0 = TR;
if (!unifiable(d0,d1)) {
return FALSE;
}
trp = TR;
while (trp != trp0) {
Term t;
--trp;
t = TrailTerm(trp);
RESET_VARIABLE(t);
}
return TRUE;
}
void
Yap_InitUnify(void)
{
@@ -940,7 +960,7 @@ Yap_InitUnify(void)
Yap_InitCPred("acyclic_term", 1, p_acyclic, SafePredFlag|TestPredFlag);
CurrentModule = TERMS_MODULE;
Yap_InitCPred("cyclic_term", 1, p_cyclic, SafePredFlag|TestPredFlag);
Yap_InitCPred("protected_unifiable", 3, p_unifiable, 0);
Yap_InitCPred("unifiable", 3, p_unifiable, 0);
CurrentModule = cm;
}

530
C/utilpreds.c
View File

@@ -1836,7 +1836,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
}
static int
expand_vts( USES_REGS1 )
expand_vts( int args USES_REGS )
{
UInt expand = LOCAL_Error_Size;
yap_error_number yap_errno = LOCAL_Error_TYPE;
@@ -1913,7 +1913,7 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */
ArityOfFunctor(f), ARG2 PASS_REGS);
}
if (out == 0L) {
if (!expand_vts( PASS_REGS1 ))
if (!expand_vts( 3 PASS_REGS ))
return FALSE;
}
} while (out == 0L);
@@ -1948,7 +1948,7 @@ p_term_variables( USES_REGS1 ) /* variables in term t */
ArityOfFunctor(f), TermNil PASS_REGS);
}
if (out == 0L) {
if (!expand_vts( PASS_REGS1 ))
if (!expand_vts( 3 PASS_REGS ))
return FALSE;
}
} while (out == 0L);
@@ -2168,7 +2168,7 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */
ArityOfFunctor(f), TermNil PASS_REGS);
}
if (out == 0L) {
if (!expand_vts( PASS_REGS1 ))
if (!expand_vts( 3 PASS_REGS ))
return FALSE;
}
} while (out == 0L);
@@ -2201,7 +2201,7 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */
ArityOfFunctor(f), ARG3 PASS_REGS);
}
if (out == 0L) {
if (!expand_vts( PASS_REGS1 ))
if (!expand_vts( 3 PASS_REGS ))
return FALSE;
}
} while (out == 0L);
@@ -2401,7 +2401,7 @@ p_variables_within_term( USES_REGS1 ) /* variables within term t */
ArityOfFunctor(f), Deref(ARG1) PASS_REGS);
}
if (out == 0L) {
if (!expand_vts( PASS_REGS1 ))
if (!expand_vts( 3 PASS_REGS ))
return FALSE;
}
} while (out == 0L);
@@ -2606,7 +2606,7 @@ p_new_variables_in_term( USES_REGS1 ) /* variables within term t */
ArityOfFunctor(f), Deref(ARG1) PASS_REGS);
}
if (out == 0L) {
if (!expand_vts( PASS_REGS1 ))
if (!expand_vts( 3 PASS_REGS ))
return FALSE;
}
} while (out == 0L);
@@ -4210,8 +4210,522 @@ p_is_list( USES_REGS1 )
return Yap_IsListTerm(Deref(ARG1));
}
static Term
numbervar(Int id)
{
Term ts[1];
ts[0] = MkIntegerTerm(id);
return Yap_MkApplTerm(FunctorVar, 1, ts);
}
static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv USES_REGS)
{
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
register tr_fr_ptr TR0 = TR;
CELL *InitialH = H;
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)) {
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_in_term_unk, vars_in_term_nvar);
/* do or pt2 are unbound */
*ptd0 = numbervar(numbv++);
/* leave an empty slot to fill in later */
if (H+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;
}
}
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 numbv;
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 = OUT_OF_TRAIL_ERROR;
LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
return -1;
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 = OUT_OF_AUXSPACE_ERROR;
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
return -1;
global_overflow:
#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);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
LOCAL_Error_Size = (ASP-H)*sizeof(CELL);
return -1;
}
Int
Yap_NumberVars( Term inp, Int numbv ) /* numbervariables in term t */
{
CACHE_REGS
Int out;
Term t;
restart:
t = Deref(inp);
if (IsVarTerm(t)) {
CELL *ptd0 = VarOfTerm(t);
*ptd0 = numbervar(numbv);
TrailTerm(TR++) = (CELL)ptd0;
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 PASS_REGS);
} else {
Functor f = FunctorOfTerm(t);
out = numbervars_in_complex_term(RepAppl(t),
RepAppl(t)+
ArityOfFunctor(f), numbv PASS_REGS);
}
if (out < 0) {
if (!expand_vts( 3 PASS_REGS ))
return FALSE;
goto restart;
}
return out;
}
static Int
p_numbervars( USES_REGS1 )
{
Term t2 = Deref(ARG2);
Int out;
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR,t2,"numbervars/3");
return FALSE;
}
if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4");
return(FALSE);
}
if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2))) < 0)
return FALSE;
return Yap_unify(ARG3, MkIntegerTerm(out));
}
static int
unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share USES_REGS)
{
struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
int ground = share;
Int max = -1;
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, unnumber_term_unk);
unnumber_term_nvar:
{
if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0);
if (ap2 >= HB && ap2 < H) {
/* If this is newer than the current term, just reuse */
*ptf++ = d0;
continue;
}
*ptf = AbsPair(H);
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(H);
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 = share;
pt0 = ap2 - 1;
pt0_end = ap2 + 1;
ptf = H;
H += 2;
if (H > 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 <= H) {
/* 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 == FunctorVar) {
Int id = IntegerOfTerm(ap2[1]);
ground = FALSE;
if (id < -1) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, "unnumber vars cannot cope with VAR(-%d)", id);
return 0L;
}
if (id <= max) {
if (ASP-(max+1) <= H) {
goto overflow;
}
/* we found this before */
*ptf++ = ASP[-id-1];
continue;
}
max = id;
if (ASP-(max+1) <= H) {
goto overflow;
}
/* new variable */
RESET_VARIABLE(ptf);
ASP[-id-1] = (CELL)ptf;
ptf++;
continue;
}
*ptf = AbsAppl(H);
ptf++;
/* 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(H);
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) && share;
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
/* store the functor for the new term */
H[0] = (CELL)f;
ptf = H+1;
H += 1+d0;
if (H > ASP - 2048) {
goto overflow;
}
} else {
/* just unnumber atoms or integers */
*ptf++ = d0;
}
continue;
}
derefa_body(d0, ptd0, unnumber_term_unk, unnumber_term_nvar);
/* this should never happen ? */
ground = FALSE;
*ptf++ = (CELL) ptd0;
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
to_visit --;
if (ground) {
CELL old = to_visit->oldv;
CELL *newp = to_visit->to-1;
CELL new = *newp;
*newp = old;
if (IsApplTerm(new))
H = RepAppl(new);
else
H = RepPair(new);
}
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 ground;
overflow:
/* oops, we're in trouble */
H = 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;
heap_overflow:
/* oops, we're in trouble */
H = 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 Term
UnnumberTerm(Term inp, UInt arity, int share USES_REGS) {
Term t = Deref(inp);
tr_fr_ptr TR0 = TR;
if (IsVarTerm(t)) {
return inp;
} else if (IsPrimitiveTerm(t)) {
return t;
} else if (IsPairTerm(t)) {
Term tf;
CELL *ap;
CELL *Hi;
restart_list:
ap = RepPair(t);
Hi = H;
tf = AbsPair(H);
H += 2;
{
int res;
if ((res = unnumber_complex_term(ap-1, ap+1, Hi, Hi, share PASS_REGS)) < 0) {
H = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
goto restart_list;
} else if (res) {
H = Hi;
return t;
}
}
return tf;
} else {
Functor f = FunctorOfTerm(t);
Term tf;
CELL *HB0;
CELL *ap;
restart_appl:
f = FunctorOfTerm(t);
HB0 = H;
ap = RepAppl(t);
tf = AbsAppl(H);
H[0] = (CELL)f;
H += 1+ArityOfFunctor(f);
if (H > ASP-128) {
H = HB0;
if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
return FALSE;
goto restart_appl;
} else {
int res;
if ((res = unnumber_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, share PASS_REGS)) < 0) {
H = HB0;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
goto restart_appl;
} else if (res && FunctorOfTerm(t) != FunctorMutable) {
H = HB0;
return t;
}
}
return tf;
}
}
Term
Yap_UnNumberTerm(Term inp, int share) {
CACHE_REGS
return UnnumberTerm(inp, 0, share PASS_REGS);
}
static Int
p_unnumbervars( USES_REGS1 ) {
/* this should be a standard Prolog term, so we allow sharing? */
return Yap_unify(Yap_UnNumberTerm(ARG1, FALSE PASS_REGS), ARG2);
}
void Yap_InitUtilCPreds(void)
{
CACHE_REGS
@@ -4233,6 +4747,8 @@ void Yap_InitUtilCPreds(void)
Yap_InitCPred("import_term", 1, p_import_term, 0);
Yap_InitCPred("export_term", 1, p_export_term, 0);
#endif
Yap_InitCPred("numbervars", 3, p_numbervars, 0);
Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0);
CurrentModule = TERMS_MODULE;
Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0);
Yap_InitCPred("term_hash", 4, p_term_hash, 0);