static Term Globalize(Term v USES_REGS) {
if (!IsVarTerm(v = Deref(v))) {
return v;
}
if (VarOfTerm(v) > HR && VarOfTerm(v) < LCL0) {
Bind_Local(VarOfTerm(v), MkVarTerm());
v = Deref(v);
}
return v;
}
static int
bind_varnames(term_t varnames ARG_LD)
{
CACHE_REGS
Term t = Yap_GetFromSlot(varnames);
while(!IsVarTerm(t) && IsPairTerm(t)) {
Term tl = HeadOfTerm(t);
Functor f;
Term tv, t2, t1;
if (!IsApplTerm(tl)) return FALSE;
if ((f = FunctorOfTerm(tl)) != FunctorEq) {
return FALSE;
}
t1 = ArgOfTerm(1, tl);
if (IsVarTerm(t1)) {
return PL_error(NULL, 0, "variable_names", ERR_INSTANTIATION, 0, t1);
}
t2 = ArgOfTerm(2, tl);
tv = Yap_MkApplTerm(LOCAL_FunctorVar, 1, &t1);
if (IsVarTerm(t2)) {
Bind_and_Trail(VarOfTerm(t2), tv);
}
t = TailOfTerm(t);
}
return TRUE;
}
static bool bind_variable_names(Term t USES_REGS) {
while (!IsVarTerm(t) && IsPairTerm(t)) {
Term tl = HeadOfTerm(t);
Functor f;
Term tv, t2, t1;
if (!IsApplTerm(tl))
return FALSE;
if ((f = FunctorOfTerm(tl)) != FunctorEq) {
return FALSE;
}
t1 = ArgOfTerm(1, tl);
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "variable_names");
return false;
}
t2 = ArgOfTerm(2, tl);
tv = Yap_MkApplTerm(FunctorDollarVar, 1, &t1);
if (IsVarTerm(t2)) {
YapBind(VarOfTerm(t2), tv);
}
t = TailOfTerm(t);
}
return true;
}
static Term
NewTimedVar(CELL val USES_REGS)
{
Term out;
timed_var *tv;
if (IsVarTerm(val) &&
VarOfTerm(val) > H) {
Term nval = MkVarTerm();
Bind_Local(VarOfTerm(val), nval);
val = nval;
}
out = AbsAppl(H);
*H++ = (CELL)FunctorMutable;
tv = (timed_var *)H;
RESET_VARIABLE(&(tv->clock));
tv->value = val;
H += sizeof(timed_var)/sizeof(CELL);
return(out);
}
Term
Yap_Globalise(Term t)
{
CACHE_REGS
CELL *vt;
Term tn;
if (!IsVarTerm(t))
return t;
vt = VarOfTerm(t);
if (vt <= HR && vt > H0)
return t;
tn = MkVarTerm();
Yap_unify(t, tn);
return tn;
}
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 Int read_stream_to_terms(USES_REGS1) {
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2");
Term t, hd;
yhandle_t tails, news;
if (sno < 0)
return FALSE;
t = AbsPair(HR);
RESET_VARIABLE(HR);
Yap_InitSlot((CELL)(HR));
tails = Yap_InitSlot((CELL)(HR));
news = Yap_InitSlot((CELL)(HR));
HR++;
while (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) {
RESET_VARIABLE(HR);
RESET_VARIABLE(HR + 1);
hd = (CELL)HR;
Yap_PutInSlot(news, (CELL)(HR + 1));
HR += 2;
while ((hd = Yap_read_term(sno, TermNil, 2)) == 0L)
;
// just ignore failure
CELL *pt = VarOfTerm(Yap_GetFromSlot(tails));
if (Deref(hd) == TermEOfCode) {
*pt = Deref(ARG3);
break;
} else {
CELL *newpt = (CELL *)Yap_GetFromSlot(news);
*pt = AbsPair(newpt - 1);
Yap_PutInSlot(tails, (CELL)newpt);
}
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify(t, ARG2);
}
static Term
syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
{
CACHE_REGS
Term info;
int count = 0, out = 0;
Int start, err = 0, end;
Term tf[7];
Term *error = tf+3;
CELL *Hi = H;
/* make sure to globalise variable */
start = tokptr->TokPos;
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
while (1) {
Term ts[2];
if (H > ASP-1024) {
tf[3] = TermNil;
err = 0;
end = 0;
/* for some reason moving this earlier confuses gcc on solaris */
H = Hi;
break;
}
if (tokptr == LOCAL_toktide) {
err = tokptr->TokPos;
out = count;
}
info = tokptr->TokInfo;
switch (tokptr->Tok) {
case Name_tok:
{
Term t0[1];
t0[0] = MkAtomTerm((Atom)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom,1),1,t0);
}
break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber,1),1,&(tokptr->TokInfo));
break;
case Var_tok:
{
Term t[3];
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_StringToList(varinfo->VarRep);
if (varinfo->VarAdr == TermNil) {
t[2] = varinfo->VarAdr = MkVarTerm();
} else {
t[2] = varinfo->VarAdr;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar,3),3,t);
}
break;
case String_tok:
{
Term t0 = Yap_StringToList((char *)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case WString_tok:
{
Term t0 = Yap_WideStringToList((wchar_t *)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case Error_tok:
case eot_tok:
break;
case Ponctuation_tok:
{
char s[2];
s[1] = '\0';
if (Ord (info) == 'l') {
s[0] = '(';
} else {
s[0] = (char)info;
}
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
}
}
if (tokptr->Tok == Ord (eot_tok)) {
*error = TermNil;
end = tokptr->TokPos;
break;
} else if (tokptr->Tok != Ord (Error_tok)) {
ts[1] = MkIntegerTerm(tokptr->TokPos);
*error =
MkPairTerm(Yap_MkApplTerm(FunctorMinus,2,ts),TermNil);
error = RepPair(*error)+1;
count++;
}
tokptr = tokptr->TokNext;
}
/* now we can throw away tokens, so we can unify and possibly overwrite TR */
Yap_unify(*outp, MkVarTerm());
if (IsVarTerm(*outp) && (VarOfTerm(*outp) > H || VarOfTerm(*outp) < H0)) {
tf[0] = Yap_MkNewApplTerm(Yap_MkFunctor(AtomRead,1),1);
} else {
tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomRead,1),1,outp);
}
{
Term t[3];
t[0] = MkIntegerTerm(start);
t[1] = MkIntegerTerm(err);
t[2] = MkIntegerTerm(end);
tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween,3),3,t);
}
tf[2] = MkAtomTerm(AtomHERE);
tf[4] = MkIntegerTerm(out);
tf[5] = MkIntegerTerm(err);
tf[6] = StreamName(st);
return(Yap_MkApplTerm(FunctorSyntaxError,7,tf));
}
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;
}
