static inline Functor
FuncAdjust(Functor f)
{
if (!IsExtensionFunctor(f)) {
AtomEntry *ae = RepAtom(NameOfFunctor(f));
MarkAtomEntry(ae);
}
return(f);
}
YAP_tag_t YAPTerm::tag() {
Term tt = gt();
if (IsVarTerm(tt)) {
CELL *pt = VarOfTerm(tt);
if (IsUnboundVar(pt)) {
CACHE_REGS
if (IsAttVar(pt))
return YAP_TAG_ATT;
return YAP_TAG_UNBOUND;
}
return YAP_TAG_REF;
}
if (IsPairTerm(tt))
return YAP_TAG_PAIR;
if (IsAtomOrIntTerm(tt)) {
if (IsAtomTerm(tt))
return YAP_TAG_ATOM;
return YAP_TAG_INT;
} else {
Functor f = FunctorOfTerm(tt);
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 = (big_blob_type)RepAppl(tt)[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;
}
}
static inline int
rational_tree(Term d0) {
CACHE_REGS
CELL **to_visit_max = (CELL **)AuxBase, **to_visit = (CELL **)AuxSp;
if (IsPairTerm(d0)) {
CELL *pt0 = RepPair(d0);
return Yap_rational_tree_loop(pt0-1, pt0+1, to_visit, to_visit_max);
} else if (IsApplTerm(d0)) {
CELL *pt0 = RepAppl(d0);
Functor f = (Functor)(*pt0);
if (IsExtensionFunctor(f))
return FALSE;
return Yap_rational_tree_loop(pt0, pt0+ArityOfFunctor(f), to_visit, to_visit_max);
} else
return FALSE;
}
YAPPredicate::YAPPredicate(Term &t, Term &tmod, CELL *&ts, const char *pname) {
Term t0 = t;
ap = nullptr;
restart:
if (IsVarTerm(t)) {
throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
} else if (IsAtomTerm(t)) {
ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
ts = nullptr;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
ts = nullptr;
ap = Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
t = Yap_MkApplTerm(FunctorCsult, 1, &t);
goto restart;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE,
Yap_TermToIndicator(t, tmod), pname);
}
if (fun == FunctorModule) {
tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
}
if (!IsAtomTerm(tmod)) {
throw YAPError(SOURCE(), TYPE_ERROR_ATOM, t0, pname);
}
t = ArgOfTerm(2, t);
goto restart;
}
ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
ts = RepAppl(t) + 1;
} else {
throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, t0, pname);
}
}
inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */
{
if (t1 == t2)
return 0;
if (IsVarTerm(t1)) {
if (IsVarTerm(t2))
return Signed(t1) - Signed(t2);
return -1;
} else if (IsVarTerm(t2)) {
/* get rid of variables */
return 1;
}
if (IsAtomOrIntTerm(t1)) {
if (IsAtomTerm(t1)) {
if (IsAtomTerm(t2))
return cmp_atoms(AtomOfTerm(t1), AtomOfTerm(t2));
if (IsPrimitiveTerm(t2))
return 1;
if (IsStringTerm(t2))
return 1;
return -1;
} else {
if (IsIntTerm(t2)) {
return IntOfTerm(t1) - IntOfTerm(t2);
}
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
case double_e:
return 1;
case long_int_e:
return IntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
case big_int_e:
return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
#endif
case db_ref_e:
return 1;
case string_e:
return -1;
}
}
return -1;
}
} else if (IsPairTerm(t1)) {
if (IsApplTerm(t2)) {
Functor f = FunctorOfTerm(t2);
if (IsExtensionFunctor(f))
return 1;
else {
if (f != FunctorDot)
return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE);
else {
return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2));
}
}
}
if (IsPairTerm(t2)) {
return (
compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepPair(t2) - 1));
} else
return 1;
} else {
/* compound term */
Functor fun1 = FunctorOfTerm(t1);
if (IsExtensionFunctor(fun1)) {
/* float, long, big, dbref */
switch ((CELL)fun1) {
case double_e: {
if (IsFloatTerm(t2))
return (rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
if (IsRefTerm(t2))
return 1;
return -1;
}
case long_int_e: {
if (IsIntTerm(t2))
return LongIntOfTerm(t1) - IntOfTerm(t2);
if (IsFloatTerm(t2)) {
return 1;
}
if (IsLongIntTerm(t2))
return LongIntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
if (IsBigIntTerm(t2)) {
return Yap_gmp_tcmp_int_big(LongIntOfTerm(t1), t2);
}
#endif
if (IsRefTerm(t2))
return 1;
return -1;
}
#ifdef USE_GMP
case big_int_e: {
if (IsIntTerm(t2))
return Yap_gmp_tcmp_big_int(t1, IntOfTerm(t2));
if (IsFloatTerm(t2)) {
return 1;
}
if (IsLongIntTerm(t2))
return Yap_gmp_tcmp_big_int(t1, LongIntOfTerm(t2));
if (IsBigIntTerm(t2)) {
return Yap_gmp_tcmp_big_big(t1, t2);
}
if (IsRefTerm(t2))
return 1;
return -1;
}
#endif
case string_e: {
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
case double_e:
return 1;
case long_int_e:
return 1;
#ifdef USE_GMP
case big_int_e:
return 1;
#endif
case db_ref_e:
return 1;
case string_e:
return strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2));
}
return -1;
}
return -1;
}
case db_ref_e:
if (IsRefTerm(t2))
return Unsigned(RefOfTerm(t2)) - Unsigned(RefOfTerm(t1));
return -1;
}
}
if (!IsApplTerm(t2)) {
if (IsPairTerm(t2)) {
Int out;
Functor f = FunctorOfTerm(t1);
if (!(out = ArityOfFunctor(f)) - 2)
out = strcmp((char *)RepAtom(NameOfFunctor(f))->StrOfAE, ".");
return out;
}
return 1;
} else {
Functor fun2 = FunctorOfTerm(t2);
Int r;
if (IsExtensionFunctor(fun2)) {
return 1;
}
r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2);
if (r)
return r;
r = cmp_atoms(NameOfFunctor(fun1), NameOfFunctor(fun2));
if (r)
return r;
else
return (compare_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(fun1),
RepAppl(t2)));
}
}
}
static Int compare_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt1) {
CACHE_REGS
register CELL **to_visit = (CELL **)HR;
register Int out = 0;
loop:
while (pt0 < pt0_end) {
register CELL d0, d1;
++pt0;
++pt1;
d0 = Derefa(pt0);
d1 = Derefa(pt1);
if (IsVarTerm(d0)) {
if (IsVarTerm(d1)) {
out = Signed(d0) - Signed(d1);
if (out)
goto done;
} else {
out = -1;
goto done;
}
} else if (IsVarTerm(d1)) {
out = 1;
goto done;
} else {
if (d0 == d1)
continue;
else if (IsAtomTerm(d0)) {
if (IsAtomTerm(d1))
out = cmp_atoms(AtomOfTerm(d0), AtomOfTerm(d1));
else if (IsPrimitiveTerm(d1))
out = 1;
else
out = -1;
/* I know out must be != 0 */
goto done;
} else if (IsIntTerm(d0)) {
if (IsIntTerm(d1))
out = IntOfTerm(d0) - IntOfTerm(d1);
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = IntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_int_big(IntOfTerm(d0), d1);
#endif
} else if (IsRefTerm(d1))
out = 1;
else
out = -1;
if (out != 0)
goto done;
} else if (IsFloatTerm(d0)) {
if (IsFloatTerm(d1)) {
out = rfloat(FloatOfTerm(d0) - FloatOfTerm(d1));
} else if (IsRefTerm(d1)) {
out = 1;
} else {
out = -1;
}
if (out != 0)
goto done;
} else if (IsStringTerm(d0)) {
if (IsStringTerm(d1)) {
out = strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1));
} else if (IsIntTerm(d1))
out = 1;
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = 1;
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = 1;
#endif
} else if (IsRefTerm(d1)) {
out = 1;
} else {
out = -1;
}
if (out != 0)
goto done;
} else if (IsLongIntTerm(d0)) {
if (IsIntTerm(d1))
out = LongIntOfTerm(d0) - IntOfTerm(d1);
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = LongIntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_int_big(LongIntOfTerm(d0), d1);
#endif
} else if (IsRefTerm(d1)) {
out = 1;
} else {
out = -1;
}
if (out != 0)
goto done;
}
#ifdef USE_GMP
else if (IsBigIntTerm(d0)) {
if (IsIntTerm(d1)) {
out = Yap_gmp_tcmp_big_int(d0, IntOfTerm(d1));
} else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = Yap_gmp_tcmp_big_int(d0, LongIntOfTerm(d1));
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_big_big(d0, d1);
} else if (IsRefTerm(d1))
out = 1;
else
out = -1;
if (out != 0)
goto done;
}
#endif
else if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
if (IsApplTerm(d1)) {
Functor f = FunctorOfTerm(d1);
if (IsExtensionFunctor(f))
out = 1;
else if (!(out = 2 - ArityOfFunctor(f)))
out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE);
} else
out = 1;
goto done;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0;
to_visit += 4;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit += 3;
}
#endif
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
pt1 = RepPair(d1) - 1;
continue;
} else if (IsRefTerm(d0)) {
if (IsRefTerm(d1))
out = Unsigned(RefOfTerm(d1)) - Unsigned(RefOfTerm(d0));
else
out = -1;
goto done;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2, *ap3;
if (!IsApplTerm(d1)) {
out = 1;
goto done;
} else {
/* store the terms to visit */
Functor f2;
ap2 = RepAppl(d0);
ap3 = RepAppl(d1);
f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) {
out = 1;
goto done;
}
f2 = (Functor)(*ap3);
if (IsExtensionFunctor(f2)) {
out = -1;
goto done;
}
/* compare functors */
if (f != (Functor)*ap3) {
if (!(out = ArityOfFunctor(f) - ArityOfFunctor(f2)))
out = cmp_atoms(NameOfFunctor(f), NameOfFunctor(f2));
goto done;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0;
to_visit += 4;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit += 3;
}
#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 **)HR) {
#ifdef RATIONAL_TREES
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
*pt0 = (CELL)to_visit[3];
#else
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
#endif
goto loop;
}
done:
/* failure */
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)HR) {
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
*pt0 = (CELL)to_visit[3];
}
#endif
return (out);
}
static Int
p_setarg( USES_REGS1 )
{
CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
Int i;
if (IsVarTerm(t3) &&
VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) {
/* local variable */
Term tn = MkVarTerm();
Bind_Local(VarOfTerm(t3), tn);
t3 = tn;
}
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
return FALSE;
} else {
if (IsIntTerm(ti))
i = IntOfTerm(ti);
else {
Term te = Yap_Eval(ti);
if (IsIntegerTerm(te)) {
i = IntegerOfTerm(te);
} else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
return FALSE;
}
}
}
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3");
} else if(IsApplTerm(ts)) {
CELL *pt;
if (IsExtensionFunctor(FunctorOfTerm(ts))) {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
if (i==0)
Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepAppl(ts)+i;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else if(IsPairTerm(ts)) {
CELL *pt;
if (i < 1 || i > 2) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepPair(ts)+i-1;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
return TRUE;
}
xarg *
Yap_ArgListToVector (Term listl, const param_t *def, int n)
{
CACHE_REGS
xarg *a = calloc( n , sizeof(xarg) );
if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule)
listl = ArgOfTerm(2,listl);
if (!IsPairTerm(listl) && listl != TermNil) {
if (IsVarTerm(listl) ) {
free( a );
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = listl;
return NULL;
}
if (IsAtomTerm(listl) ) {
xarg *na = matchKey( AtomOfTerm(listl), a, n, def);
if (!na) {
free( a );
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = listl;
return NULL;
}
} else if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm( listl );
if (IsExtensionFunctor(f)) {
free( a );
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = listl;
return NULL;
}
arity_t arity = ArityOfFunctor( f );
if (arity != 1) {
free( a );
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = listl;
return NULL;
}
xarg *na = matchKey( NameOfFunctor( f ), a, n, def);
if (!na) {
free( a );
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = listl;
return NULL;
}
} else {
free( a );
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = listl;
return NULL;
}
listl = MkPairTerm( listl, TermNil );
}
while (IsPairTerm(listl)) {
Term hd = HeadOfTerm( listl );
listl = TailOfTerm( listl );
if (IsVarTerm(hd) || IsVarTerm(listl)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
if (IsVarTerm(hd)) {
LOCAL_Error_Term = hd;
} else {
LOCAL_Error_Term = listl;
}
free( a );
return NULL;
}
if (IsAtomTerm(hd)) {
xarg *na = matchKey( AtomOfTerm( hd ), a, n, def);
if (!na)
return NULL;
na->used = true;
na->tvalue = TermNil;
continue;
} else if (IsApplTerm( hd )) {
Functor f = FunctorOfTerm( hd );
if (IsExtensionFunctor(f)) {
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
LOCAL_Error_Term = hd;
free( a );
return NULL;
}
arity_t arity = ArityOfFunctor( f );
if (arity != 1) {
LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE;
LOCAL_Error_Term = hd;
free( a );
return NULL;
}
xarg *na = matchKey( NameOfFunctor( f ), a, n, def);
if (!na) {
free( a );
return NULL;
}
na->used = 1;
na->tvalue = ArgOfTerm(1, hd);
} else {
LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
free( a );
return NULL;
}
}
if (IsVarTerm(listl)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = listl;
free( a );
return NULL;
} else if (listl != TermNil) {
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = listl;
free( a );
return NULL;
}
return a;
}
static int
unifiable(CELL d0, CELL d1)
{
CACHE_REGS
#if THREADS
#undef Yap_REGS
register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
register REGSTORE *regp = &Yap_REGS;
#define Yap_REGS (*regp)
#endif /* defined(B) || defined(TR) */
#endif
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
register CELL *pt0, *pt1;
deref_head(d0, unifiable_unk);
unifiable_nvar:
/* d0 is bound */
deref_head(d1, unifiable_nvar_unk);
unifiable_nvar_nvar:
/* both arguments are bound */
if (d0 == d1)
return TRUE;
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
return (FALSE);
}
pt0 = RepPair(d0);
pt1 = RepPair(d1);
return (unifiable_complex(pt0 - 1, pt0 + 1, pt1 - 1));
}
else if (IsApplTerm(d0)) {
pt0 = RepAppl(d0);
d0 = *pt0;
if (!IsApplTerm(d1))
return (FALSE);
pt1 = RepAppl(d1);
d1 = *pt1;
if (d0 != d1) {
return (FALSE);
} else {
if (IsExtensionFunctor((Functor)d0)) {
switch(d0) {
case (CELL)FunctorDBRef:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP
case (CELL)FunctorBigInt:
return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
#endif /* USE_GMP */
default:
return(FALSE);
}
}
return (unifiable_complex(pt0, pt0 + ArityOfFunctor((Functor) d0),
pt1));
}
} else {
return (FALSE);
}
deref_body(d1, pt1, unifiable_nvar_unk, unifiable_nvar_nvar);
/* d0 is bound and d1 is unbound */
*(pt1) = d0;
DO_TRAIL(pt1, d0);
return (TRUE);
deref_body(d0, pt0, unifiable_unk, unifiable_nvar);
/* pt0 is unbound */
deref_head(d1, unifiable_var_unk);
unifiable_var_nvar:
/* pt0 is unbound and d1 is bound */
*pt0 = d1;
DO_TRAIL(pt0, d1);
return TRUE;
deref_body(d1, pt1, unifiable_var_unk, unifiable_var_nvar);
/* d0 and pt1 are unbound */
UnifyAndTrailCells(pt0, pt1);
return (TRUE);
#if THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
#undef Yap_REGS
#endif /* defined(B) || defined(TR) */
#endif
}
static int
unifiable_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
{
CACHE_REGS
#ifdef THREADS
#undef Yap_REGS
register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif defined(SHADOW_REGS)
#if defined(B) || defined(TR)
register REGSTORE *regp = &Yap_REGS;
#define Yap_REGS (*regp)
#endif /* defined(B) || defined(TR) || defined(HB) */
#endif
#ifdef SHADOW_HB
register CELL *HBREG = HB;
#endif /* SHADOW_HB */
struct unif_record *unif = (struct unif_record *)AuxBase;
struct v_record *to_visit = (struct v_record *)AuxSp;
#define unif_base ((struct unif_record *)AuxBase)
#define to_visit_base ((struct v_record *)AuxSp)
loop:
while (pt0 < pt0_end) {
register CELL *ptd0 = pt0+1;
register CELL d0;
++pt1;
pt0 = ptd0;
d0 = *ptd0;
deref_head(d0, unifiable_comp_unk);
unifiable_comp_nvar:
{
register CELL *ptd1 = pt1;
register CELL d1 = *ptd1;
deref_head(d1, unifiable_comp_nvar_unk);
unifiable_comp_nvar_nvar:
if (d0 == d1)
continue;
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
goto cufail;
}
/* now link the two structures so that no one else will */
/* come here */
/* store the terms to visit */
if (RATIONAL_TREES || pt0 < pt0_end) {
to_visit --;
#ifdef RATIONAL_TREES
unif++;
#endif
if ((void *)to_visit < (void *)unif) {
CELL **urec = (CELL **)unif;
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
unif = (struct unif_record *)urec;
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
#ifdef RATIONAL_TREES
unif[-1].old = *pt0;
unif[-1].ptr = pt0;
*pt0 = d1;
#endif
}
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
pt1 = RepPair(d1) - 1;
continue;
}
if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2, *ap3;
if (!IsApplTerm(d1)) {
goto cufail;
}
/* store the terms to visit */
ap2 = RepAppl(d0);
ap3 = RepAppl(d1);
f = (Functor) (*ap2);
/* compare functors */
if (f != (Functor) *ap3)
goto cufail;
if (IsExtensionFunctor(f)) {
if (unify_extension(f, d0, ap2, d1))
continue;
goto cufail;
}
/* now link the two structures so that no one else will */
/* come here */
/* store the terms to visit */
if (RATIONAL_TREES || pt0 < pt0_end) {
to_visit --;
#ifdef RATIONAL_TREES
unif++;
#endif
if ((void *)to_visit < (void *)unif) {
CELL **urec = (CELL **)unif;
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
unif = (struct unif_record *)urec;
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
#ifdef RATIONAL_TREES
unif[-1].old = *pt0;
unif[-1].ptr = pt0;
*pt0 = d1;
#endif
}
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
pt1 = ap3;
continue;
}
goto cufail;
derefa_body(d1, ptd1, unifiable_comp_nvar_unk, unifiable_comp_nvar_nvar);
/* d1 and pt2 have the unbound value, whereas d0 is bound */
*(ptd1) = d0;
DO_TRAIL(ptd1, d0);
continue;
}
derefa_body(d0, ptd0, unifiable_comp_unk, unifiable_comp_nvar);
/* first arg var */
{
register CELL d1;
register CELL *ptd1;
ptd1 = pt1;
d1 = ptd1[0];
/* pt2 is unbound */
deref_head(d1, unifiable_comp_var_unk);
unifiable_comp_var_nvar:
/* pt2 is unbound and d1 is bound */
*ptd0 = d1;
DO_TRAIL(ptd0, d1);
continue;
derefa_body(d1, ptd1, unifiable_comp_var_unk, unifiable_comp_var_nvar);
/* ptd0 and ptd1 are unbound */
UnifyAndTrailGlobalCells(ptd0, ptd1);
}
}
/* Do we still have compound terms to visit */
if (to_visit < to_visit_base) {
pt0 = to_visit->start0;
pt0_end = to_visit->end0;
pt1 = to_visit->start1;
to_visit++;
goto loop;
}
#ifdef RATIONAL_TREES
/* restore bindigs */
while (unif-- != unif_base) {
CELL *pt0;
pt0 = unif->ptr;
*pt0 = unif->old;
}
#endif
return TRUE;
cufail:
#ifdef RATIONAL_TREES
/* restore bindigs */
while (unif-- != unif_base) {
CELL *pt0;
pt0 = unif->ptr;
*pt0 = unif->old;
}
#endif
return FALSE;
#ifdef THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)
#elif defined(SHADOW_REGS)
#if defined(B) || defined(TR)
#undef Yap_REGS
#endif /* defined(B) || defined(TR) */
#endif
}
int
Yap_rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit, CELL **to_visit_max)
{
CELL ** base = to_visit;
rtree_loop:
while (pt0 < pt0_end) {
register CELL *ptd0;
register CELL d0;
ptd0 = ++pt0;
pt0 = ptd0;
d0 = *ptd0;
deref_head(d0, rtree_loop_unk);
rtree_loop_nvar:
{
if (d0 == TermFoundVar)
goto cufail;
if (IsPairTerm(d0)) {
to_visit -= 3;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, &to_visit_max, &base);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
*pt0 = TermFoundVar;
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
continue;
}
if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor) (*ap2);
/* compare functors */
if (IsExtensionFunctor(f)) {
continue;
}
to_visit -= 3;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, &to_visit_max, &base);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
*pt0 = TermFoundVar;
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
continue;
}
continue;
}
derefa_body(d0, ptd0, rtree_loop_unk, rtree_loop_nvar);
}
/* Do we still have compound terms to visit */
if (to_visit < base) {
pt0 = to_visit[0];
pt0_end = to_visit[1];
*pt0 = (CELL)to_visit[2];
to_visit += 3;
goto rtree_loop;
}
return FALSE;
cufail:
/* we found an infinite term */
while (to_visit < (CELL **)base) {
CELL *pt0;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
to_visit += 3;
}
return TRUE;
}
static int
OCUnify(register CELL d0, register CELL d1)
{
CACHE_REGS
register CELL *pt0, *pt1;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
deref_head(d0, oc_unify_unk);
oc_unify_nvar:
/* d0 is bound */
deref_head(d1, oc_unify_nvar_unk);
oc_unify_nvar_nvar:
if (d0 == d1) {
return (!rational_tree(d0));
}
/* both arguments are bound */
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
return (FALSE);
}
pt0 = RepPair(d0);
pt1 = RepPair(d1);
return (OCUnify_complex(pt0 - 1, pt0 + 1, pt1 - 1));
}
else if (IsApplTerm(d0)) {
if (!IsApplTerm(d1))
return (FALSE);
pt0 = RepAppl(d0);
d0 = *pt0;
pt1 = RepAppl(d1);
d1 = *pt1;
if (d0 != d1) {
return (FALSE);
} else {
if (IsExtensionFunctor((Functor)d0)) {
switch(d0) {
case (CELL)FunctorDBRef:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
#ifdef USE_GMP
case (CELL)FunctorBigInt:
return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
#endif /* USE_GMP */
default:
return(FALSE);
}
}
return (OCUnify_complex(pt0, pt0 + ArityOfFunctor((Functor) d0),
pt1));
}
} else {
return(FALSE);
}
deref_body(d1, pt1, oc_unify_nvar_unk, oc_unify_nvar_nvar);
/* d0 is bound and d1 is unbound */
YapBind(pt1, d0);
/* local variables cannot be in a term */
if (pt1 > HR && pt1 < LCL0)
return TRUE;
if (rational_tree(d0))
return(FALSE);
return (TRUE);
deref_body(d0, pt0, oc_unify_unk, oc_unify_nvar);
/* pt0 is unbound */
deref_head(d1, oc_unify_var_unk);
oc_unify_var_nvar:
/* pt0 is unbound and d1 is bound */
YapBind(pt0, d1);
/* local variables cannot be in a term */
if (pt0 > HR && pt0 < LCL0)
return TRUE;
if (rational_tree(d1))
return(FALSE);
return (TRUE);
deref_body(d1, pt1, oc_unify_var_unk, oc_unify_var_nvar);
/* d0 and pt1 are unbound */
UnifyCells(pt0, pt1);
return (TRUE);
return (TRUE);
}
/// Yap_ArgList2ToVector is much the same as before,
/// but assumes parameters also have something called a
/// scope
xarg *
Yap_ArgList2ToVector (Term listl, const param2_t *def, int n)
{
CACHE_REGS
xarg *a = calloc( n , sizeof(xarg) );
if (!IsPairTerm(listl) && listl != TermNil) {
if (IsVarTerm(listl) ) {
return failed( INSTANTIATION_ERROR, listl, a);
}
if (IsAtomTerm(listl) ) {
xarg *na = matchKey2( AtomOfTerm(listl), a, n, def);
if (!na) {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
}
}
if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm( listl );
if (IsExtensionFunctor(f)) {
return failed( TYPE_ERROR_PARAMETER, listl, a);
}
arity_t arity = ArityOfFunctor( f );
if (arity != 1) {
return failed( TYPE_ERROR_LIST, listl, a);
}
xarg *na = matchKey2( NameOfFunctor( f ), a, n, def);
if (!na) {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
}
} else {
return failed( TYPE_ERROR_LIST, listl, a);
}
listl = MkPairTerm( listl, TermNil );
}
while (IsPairTerm(listl)) {
Term hd = HeadOfTerm( listl );
if (IsVarTerm(hd)) {
return failed( INSTANTIATION_ERROR, hd, a);
}
if (IsAtomTerm(hd)) {
xarg *na = matchKey2( AtomOfTerm( hd ), a, n, def);
if (!na) {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
}
na->used = true;
na->tvalue = TermNil;
continue;
} else if (IsApplTerm( hd )) {
Functor f = FunctorOfTerm( hd );
if (IsExtensionFunctor(f)) {
return failed( TYPE_ERROR_PARAMETER, hd, a);
}
arity_t arity = ArityOfFunctor( f );
if (arity != 1) {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
}
xarg *na = matchKey2( NameOfFunctor( f ), a, n, def);
if (na) {
na->used = 1;
na->tvalue = ArgOfTerm(1, hd);
} else {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
}
} else {
return failed( INSTANTIATION_ERROR, hd, a);
}
listl = TailOfTerm(listl);
}
if (IsVarTerm(listl)) {
return failed( INSTANTIATION_ERROR, listl, a);
}
if (TermNil != listl) {
return failed( TYPE_ERROR_LIST, listl, a);
}
return a;
}