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;
}
/* copy to a new list of terms */
static Int
build_new_list(CELL *pt, Term t USES_REGS)
{
Int out = 0;
if (IsVarTerm(t))
return(-1);
if (t == TermNil)
return(0);
restart:
while (IsPairTerm(t)) {
out++;
pt[0] = HeadOfTerm(t);
t = TailOfTerm(t);
if (IsVarTerm(t))
return(-1);
if (t == TermNil) {
return(out);
}
pt += 2;
if (pt > ASP - 4096) {
if (!Yap_gcl((ASP-HR)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
pt = HR;
out = 0;
goto restart;
}
}
return(-1);
}
Term YAPListTerm::car() {
Term to = gt();
if (IsPairTerm(to))
return (HeadOfTerm(to));
else {
throw YAPError(SOURCE(), TYPE_ERROR_LIST, to, "");
return TermUnique;
}
}
Term YAPListTerm::car() {
Term to = gt();
if (IsPairTerm(to))
return (HeadOfTerm(to));
else {
Yap_Error(TYPE_ERROR_LIST, to, "");
throw YAPError();
}
}
std::vector<YAPTerm> YAPPairTerm::listToVector() {
Term *tailp;
Term t1 = gt();
Int l = Yap_SkipList(&t1, &tailp);
if (l < 0) {
throw YAPError(SOURCE(), TYPE_ERROR_LIST, (t), nullptr);
}
std::vector<YAPTerm> o = *new std::vector<YAPTerm>(l);
int i = 0;
Term t = gt();
while (t != TermNil) {
o[i++] = YAPTerm(HeadOfTerm(t));
t = TailOfTerm(t);
}
return o;
}
Term &YAPListTerm::operator[](arity_t i) {
BACKUP_MACHINE_REGS();
Term t0 = gt();
Term tf = 0;
while (IsPairTerm(t0)) {
if (i == 0) {
tf = HeadOfTerm(t0);
break;
} else {
t0 = TailOfTerm(t0);
i--;
}
}
RECOVER_MACHINE_REGS();
return RepPair(tf)[i];
}
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 Int
open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */
{
Term t, ti;
int sno;
Int sl = 0, nchars = 0;
char *nbuf;
ti = Deref(ARG1);
while (ti != TermNil) {
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "open_mem_read_stream");
return (FALSE);
} else if (!IsPairTerm(ti)) {
Yap_Error(TYPE_ERROR_LIST, ti, "open_mem_read_stream");
return (FALSE);
} else {
sl++;
ti = TailOfTerm(ti);
}
}
while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
}
ti = Deref(ARG1);
while (ti != TermNil) {
Term ts = HeadOfTerm(ti);
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "open_mem_read_stream");
return (FALSE);
} else if (!IsIntTerm(ts)) {
Yap_Error(TYPE_ERROR_INTEGER, ARG1, "open_mem_read_stream");
return (FALSE);
}
nbuf[nchars++] = IntOfTerm(ts);
ti = TailOfTerm(ti);
}
nbuf[nchars] = '\0';
sno = Yap_open_buf_read_stream(nbuf, nchars, &LOCAL_encoding, MEM_BUF_CODE);
t = Yap_MkStream (sno);
return (Yap_unify (ARG2, t));
}
static int unbind_variable_names(Term t USES_REGS) {
while (!IsVarTerm(t) && IsPairTerm(t)) {
Term tl = HeadOfTerm(t);
Functor f;
Term *tp2, t1;
if (!IsApplTerm(tl))
return FALSE;
if ((f = FunctorOfTerm(tl)) != FunctorEq) {
return FALSE;
}
t1 = ArgOfTerm(1, tl);
tp2 = RepAppl(tl) + 2;
while (*tp2 != t1) {
tp2 = (CELL *)*tp2;
}
RESET_VARIABLE(tp2);
t = TailOfTerm(t);
}
return TRUE;
}
Term &YAPTerm::operator[](arity_t i) {
BACKUP_MACHINE_REGS();
Term t0 = gt();
Term tf = 0;
if (IsApplTerm(t0)) {
// Functor f = FunctorOfTerm(t0);
// if (IsExtensionFunctor(f))
// return 0;
tf = RepAppl(t0)[(i + 1)];
} else if (IsPairTerm(t0)) {
if (i == 0)
tf = HeadOfTerm(t0);
else if (i == 1)
tf = TailOfTerm(t0);
RECOVER_MACHINE_REGS();
tf = RepPair(tf)[i];
}
RECOVER_MACHINE_REGS();
Yap_Error(TYPE_ERROR_COMPOUND, tf, "");
throw YAPError();
}
Term YAPTerm::getArg(arity_t i) {
BACKUP_MACHINE_REGS();
Term tf = 0;
Term t0 = gt();
if (IsApplTerm(t0)) {
if (i > ArityOfFunctor(FunctorOfTerm(t0)))
throw YAPError(SOURCE(), DOMAIN_ERROR_OUT_OF_RANGE, t0, "t0.getArg()");
tf = (ArgOfTerm(i, t0));
} else if (IsPairTerm(t0)) {
if (i == 1)
tf = (HeadOfTerm(t0));
else if (i == 2)
tf = (TailOfTerm(t0));
else
throw YAPError(SOURCE(), DOMAIN_ERROR_OUT_OF_RANGE, t0, "t0.getArg()");
} else {
throw YAPError(SOURCE(), TYPE_ERROR_COMPOUND, t0, "t0.getArg()");
}
RECOVER_MACHINE_REGS();
return tf;
}
static Term
Eval(Term t USES_REGS)
{
if (IsVarTerm(t)) {
return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic");
} else if (IsNumTerm(t)) {
return t;
} else if (IsAtomTerm(t)) {
ExpEntry *p;
Atom name = AtomOfTerm(t);
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
/* error */
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntTerm(0);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"atom %s in arithmetic expression",
RepAtom(name)->StrOfAE);
}
return Yap_eval_atom(p->FOfEE);
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (fun == FunctorString) {
const char *s = StringOfTerm(t);
if (s[1] == '\0')
return MkIntegerTerm(s[0]);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"string in arithmetic expression");
} else if ((Atom)fun == AtomFoundVar) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil,
"cyclic term in arithmetic expression");
} else {
Int n = ArityOfFunctor(fun);
Atom name = NameOfFunctor(fun);
ExpEntry *p;
Term t1, t2;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntegerTerm(n);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"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) {
*RepAppl(t) = (CELL)fun;
return FALSE;
}
if (n == 1) {
*RepAppl(t) = (CELL)fun;
return Yap_eval_unary(p->FOfEE, t1);
}
t2 = Eval(ArgOfTerm(2,t) PASS_REGS);
*RepAppl(t) = (CELL)fun;
if (t2 == 0L)
return FALSE;
return Yap_eval_binary(p->FOfEE,t1,t2);
}
} /* else if (IsPairTerm(t)) */ {
if (TailOfTerm(t) != TermNil) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"string must contain a single character to be evaluated as an arithmetic expression");
}
return Eval(HeadOfTerm(t) PASS_REGS);
}
}
static Int p_table( USES_REGS1 ) {
Term mod, t, list;
PredEntry *pe;
Atom at;
int arity;
tab_ent_ptr tab_ent;
#ifdef MODE_DIRECTED_TABLING
int* mode_directed = NULL;
#endif /* MODE_DIRECTED_TABLING */
mod = Deref(ARG1);
t = Deref(ARG2);
list = Deref(ARG3);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
arity = 0;
} else if (IsApplTerm(t)) {
at = NameOfFunctor(FunctorOfTerm(t));
pe = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod));
arity = ArityOfFunctor(FunctorOfTerm(t));
} else
return (FALSE);
if (list != TermNil) { /* non-empty list */
#ifndef MODE_DIRECTED_TABLING
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (mode directed tabling not enabled)", AtomName(at), arity);
return(FALSE);
#else
/*************************************************************************************
The mode operator declaration is reordered as follows:
1. arguments with mode 'index' (any number)
2. arguments with mode 'min' and 'max' (any number, following the original order)
3. arguments with mode 'all' (any number)
4. arguments with mode 'sum' or 'last' (only one of the two is allowed)
5. arguments with mode 'first' (any number)
*************************************************************************************/
int pos_index = 0;
int pos_min_max = 0;
int pos_all = 0;
int pos_sum_last = 0;
int pos_first = 0;
int i;
int *aux_mode_directed;
aux_mode_directed = malloc(arity * sizeof(int));
for (i = 0; i < arity; i++) {
int mode = IntOfTerm(HeadOfTerm(list));
if (mode == MODE_DIRECTED_INDEX)
pos_index++;
else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX)
pos_min_max++;
else if (mode == MODE_DIRECTED_ALL)
pos_all++;
else if (mode == MODE_DIRECTED_SUM || mode == MODE_DIRECTED_LAST) {
if (pos_sum_last) {
free(aux_mode_directed);
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (more than one argument with modes 'sum' and/or 'last')", AtomName(at), arity);
return(FALSE);
} else
pos_sum_last = 1;
}
aux_mode_directed[i] = mode;
list = TailOfTerm(list);
}
pos_first = pos_index + pos_min_max + pos_all + pos_sum_last;
pos_sum_last = pos_index + pos_min_max + pos_all;
pos_all = pos_index + pos_min_max;
pos_min_max = pos_index;
pos_index = 0;
ALLOC_BLOCK(mode_directed, arity * sizeof(int), int);
for (i = 0; i < arity; i++) {
int aux_pos = 0;
if (aux_mode_directed[i] == MODE_DIRECTED_INDEX)
aux_pos = pos_index++;
else if (aux_mode_directed[i] == MODE_DIRECTED_MIN || aux_mode_directed[i] == MODE_DIRECTED_MAX)
aux_pos = pos_min_max++;
else if (aux_mode_directed[i] == MODE_DIRECTED_ALL)
aux_pos = pos_all++;
else if (aux_mode_directed[i] == MODE_DIRECTED_SUM || aux_mode_directed[i] == MODE_DIRECTED_LAST)
aux_pos = pos_sum_last++;
else if(aux_mode_directed[i] == MODE_DIRECTED_FIRST)
aux_pos = pos_first++;
mode_directed[aux_pos] = MODE_DIRECTED_SET(i, aux_mode_directed[i]);
}
free(aux_mode_directed);
#endif /* MODE_DIRECTED_TABLING */
}
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;
}
/// 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;
}