static Term add_names(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
}
}
static Term add_priority(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
}
}
static Int
p_stream_to_terms(void)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
Term t = Deref(ARG3), tpos = TermNil;
if (sno < 0)
return FALSE;
while (!(Stream[sno].status & Eof_Stream_f)) {
/* skip errors */
TokEntry *tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos);
if (!Yap_ErrorMessage)
{
Term th = Yap_Parse();
if (H >= ASP-1024) {
UNLOCK(Stream[sno].streamlock);
Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_terms/3");
return FALSE;
}
if (!th || Yap_ErrorMessage)
break;
if (th == MkAtomTerm (AtomEof)) {
UNLOCK(Stream[sno].streamlock);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return Yap_unify(t,ARG2);
} else {
t = MkPairTerm(th,t);
}
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
}
UNLOCK(Stream[sno].streamlock);
return Yap_unify(t,ARG2);
}
static Term
VarNames(VarEntry *p,Term l USES_REGS)
{
if (p != NULL) {
if (strcmp(p->VarRep, "_") != 0) {
Term t[2];
Term o;
t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep));
t[1] = p->VarAdr;
o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, VarNames(p->VarRight,
VarNames(p->VarLeft,l PASS_REGS) PASS_REGS));
if (HR > ASP-4096) {
save_machine_regs();
siglongjmp(LOCAL_IOBotch,1);
}
return(o);
} else {
return VarNames(p->VarRight,VarNames(p->VarLeft,l PASS_REGS) PASS_REGS);
}
} else {
return (l);
}
}
static YAP_Term add_key_b(const char *key, bool v, YAP_Term o0) {
YAP_Term tkv[2];
tkv[1] = v ? TermTrue : TermFalse;
tkv[0] = MkStringTerm(key);
Term node = Yap_MkApplTerm(FunctorEq, 2, tkv);
return MkPairTerm(node, o0);
}
static YAP_Term add_key_s(const char *key, const char *v, YAP_Term o0) {
Term tkv[2];
if (!v || v[0] == '\0')
return o0;
tkv[1] = MkStringTerm(v), tkv[0] = MkStringTerm(key);
Term node = Yap_MkApplTerm(FunctorEq, 2, tkv);
return MkPairTerm(node, o0);
}
Term
Yap_MkApplTerm(Functor f, unsigned int n, register Term *a)
/* build compound term with functor f and n
* args a */
{
CACHE_REGS
CELL *t = HR;
if (n == 0)
return (MkAtomTerm(NameOfFunctor(f)));
if (f == FunctorList)
return MkPairTerm(a[0], a[1]);
*HR++ = (CELL) f;
while (n--)
*HR++ = (CELL) * a++;
return (AbsAppl(t));
}
static Int
p_unifiable( USES_REGS1 )
{
tr_fr_ptr trp, trp0 = TR;
Term tf = TermNil;
if (!unifiable(ARG1,ARG2)) {
return FALSE;
}
trp = TR;
while (trp != trp0) {
Term t[2];
--trp;
t[0] = TrailTerm(trp);
t[1] = *(CELL *)t[0];
tf = MkPairTerm(Yap_MkApplTerm(FunctorEq,2,t),tf);
RESET_VARIABLE(t[0]);
}
return Yap_unify(ARG3, tf);
}
static Int
peek_mem_write_stream ( USES_REGS1 )
{ /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */
Int sno = Yap_CheckStream (ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2");
Int i;
Term tf = ARG2;
CELL *HI;
const char *ptr;
if (sno < 0)
return (FALSE);
restart:
HI = HR;
#if MAY_WRITE
if (fflush(GLOBAL_Stream[sno].file) == 0) {
ptr = GLOBAL_Stream[sno].nbuf;
i = GLOBAL_Stream[sno].nsize;
}
#else
ptr = GLOBAL_Stream[sno].u.mem_string.buf;
i = GLOBAL_Stream[sno].u.mem_string.pos;
#endif
while (i > 0) {
--i;
tf = MkPairTerm(MkIntTerm(ptr[i]),tf);
if (HR + 1024 >= ASP) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
HR = HI;
if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, Yap_gcP()) ) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
i = GLOBAL_Stream[sno].u.mem_string.pos;
tf = ARG2;
LOCK(GLOBAL_Stream[sno].streamlock);
goto restart;
}
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify(ARG3,tf));
}
YAPPairTerm::YAPPairTerm(YAPTerm th, YAPTerm tl) : YAPTerm() {
CACHE_REGS
BACKUP_H();
mk ( MkPairTerm( th.term(), tl.term() ) );
RECOVER_H();
}
/**
* Syntax Error Handler
*
* @par tokptr: the sequence of tokens
* @par sno: the stream numbet
*
* Implicit arguments:
* +
*/
Term Yap_syntax_error(TokEntry *errtok, int sno) {
CACHE_REGS
Term info;
Term startline, errline, endline;
Term tf[4];
Term *tailp = tf + 3;
CELL *Hi = HR;
TokEntry *tok = LOCAL_tokptr;
Int cline = tok->TokPos;
startline = MkIntegerTerm(cline);
if (errtok != LOCAL_toktide) {
errtok = LOCAL_toktide;
}
LOCAL_Error_TYPE = YAP_NO_ERROR;
errline = MkIntegerTerm(errtok->TokPos);
if (LOCAL_ErrorMessage)
tf[0] = MkStringTerm(LOCAL_ErrorMessage);
else
tf[0] = MkStringTerm("");
while (tok) {
Term ts[2];
if (HR > ASP - 1024) {
errline = MkIntegerTerm(0);
endline = MkIntegerTerm(0);
/* for some reason moving this earlier confuses gcc on solaris */
HR = Hi;
break;
}
if (tok->TokPos != cline) {
*tailp = MkPairTerm(TermNewLine, TermNil);
tailp = RepPair(*tailp) + 1;
cline = tok->TokPos;
}
if (tok == errtok && tok->Tok != Error_tok) {
*tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil);
tailp = RepPair(*tailp) + 1;
}
info = tok->TokInfo;
switch (tok->Tok) {
case Name_tok: {
Term t0[1];
if (info) {
t0[0] = MkAtomTerm((Atom)info);
} else {
t0[0] = TermNil;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case QuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case WQuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo));
break;
case Var_tok: {
Term t[2];
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
} break;
case String_tok: {
Term t0 =
Yap_CharsToTDQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS);
if (!t0) {
return 0;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WString_tok: {
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, CurrentModule PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case BQString_tok: {
Term t0 =
Yap_CharsToTBQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WBQString_tok: {
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, CurrentModule PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case Error_tok: {
ts[0] = MkAtomTerm(AtomError);
} break;
case eot_tok:
endline = MkIntegerTerm(tok->TokPos);
ts[0] = MkAtomTerm(Yap_LookupAtom("EOT"));
break;
case Ponctuation_tok: {
char s[2];
s[1] = '\0';
if ((info) == 'l') {
s[0] = '(';
} else {
s[0] = (char)info;
}
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
}
}
tok = tok->TokNext;
if (!tok)
break;
*tailp = MkPairTerm(ts[0], TermNil);
tailp = RepPair(*tailp) + 1;
}
{
Term t[3];
t[0] = startline;
t[1] = errline;
t[2] = endline;
tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t);
}
/* 0: id */
/* 1: strat, error, end line */
/*2 msg */
/* file */
tf[2] = Yap_StreamUserName(sno);
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
Term terr = Yap_MkApplTerm(FunctorSyntaxError, 4, tf);
Term tn[2];
tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &terr);
tn[1] = TermNil;
terr = Yap_MkApplTerm(FunctorError, 2, tn);
#if DEBUG
if (Yap_ExecutionMode == YAP_BOOT_MODE) {
fprintf(stderr, "SYNTAX ERROR while booting: ");
Yap_DebugPlWriteln(terr);
}
#endif
return terr;
}
/**
* Syntax Error Handler
*
* @par tokptr: the sequence of tokens
* @par sno: the stream numbet
*
* Implicit arguments:
* +
*/
static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
CACHE_REGS
Term startline, errline, endline;
Term tf[3];
Term tm;
Term *tailp = tf + 2;
CELL *Hi = HR;
TokEntry *tok = LOCAL_tokptr;
Int cline = tok->TokPos;
startline = MkIntegerTerm(cline);
endline = MkIntegerTerm(cline);
if (errtok != LOCAL_toktide) {
errtok = LOCAL_toktide;
}
LOCAL_Error_TYPE = YAP_NO_ERROR;
errline = MkIntegerTerm(errtok->TokPos);
if (LOCAL_ErrorMessage)
tm = MkStringTerm(LOCAL_ErrorMessage);
else
tm = MkStringTerm("syntax error");
while (tok) {
if (HR > ASP - 1024) {
errline = MkIntegerTerm(0);
endline = MkIntegerTerm(0);
/* for some reason moving this earlier confuses gcc on solaris */
HR = Hi;
break;
}
if (tok->TokPos != cline) {
*tailp = MkPairTerm(TermNewLine, TermNil);
tailp = RepPair(*tailp) + 1;
cline = tok->TokPos;
}
if (tok == errtok && tok->Tok != Error_tok) {
*tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil);
tailp = RepPair(*tailp) + 1;
}
Term rep = Yap_tokRep(tok);
if (tok->TokNext) {
tok = tok->TokNext;
} else {
endline = MkIntegerTerm(tok->TokPos);
tok = NULL;
break;
}
*tailp = MkPairTerm(rep, TermNil);
tailp = RepPair(*tailp) + 1;
}
{
Term t[3];
t[0] = startline;
t[1] = errline;
t[2] = endline;
tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t);
}
/* 0: strat, error, end line */
/*2 msg */
/* 1: file */
tf[1] = Yap_StreamUserName(sno);
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
Term terr = Yap_MkApplTerm(FunctorInfo3, 3, tf);
Term tn[2];
tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &tm);
tn[1] = terr;
terr = Yap_MkApplTerm(FunctorError, 2, tn);
#if DEBUG
if (Yap_ExecutionMode == YAP_BOOT_MODE) {
fprintf(stderr, "SYNTAX ERROR while booting: ");
Yap_DebugPlWriteln(terr);
}
#endif
return terr;
}
/* Return a list of files for a directory */
static Int list_directory(USES_REGS1) {
Term tf = MkAtomTerm(Yap_LookupAtom("[]"));
yhandle_t sl = Yap_InitSlot(tf);
VFS_t *vfsp;
char *buf = (char *)AtomName(AtomOfTerm(ARG1));
if ((vfsp = vfs_owner(buf))) {
void *de;
const char *dp;
if ((de = vfsp->opendir(vfsp, buf)) == NULL) {
PlIOError(PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in list_directory",
strerror(errno));
}
while ((dp = vfsp->nextdir( de))) {
YAP_Term ti = MkAtomTerm(Yap_LookupAtom(dp));
Yap_PutInHandle(sl, MkPairTerm(ti, Yap_GetFromHandle(sl)));
}
vfsp->closedir( de);
} else {
#if defined(__MINGW32__) || _MSC_VER
struct _finddata_t c_file;
char bs[BUF_SIZE];
long hFile;
bs[0] = '\0';
#if HAVE_STRNCPY
strncpy(bs, buf, BUF_SIZE);
#else
strcpy(bs, buf);
#endif
#if HAVE_STRNCAT
strncat(bs, "/*", BUF_SIZE);
#else
strcat(bs, "/*");
#endif
if ((hFile = _findfirst(bs, &c_file)) == -1L) {
return (Yap_unify(ARG2, tf));
}
Yap_PutInSlot(sl, MkPairTerm(MkAtomTerm(Yap_LookupAtom(c_file.name)),
Yap_GetFromSlot(sl)));
while (_findnext(hFile, &c_file) == 0) {
Term ti = MkAtomTerm(Yap_LookupAtom(c_file.name));
Yap_PutInSlot(sl, MkPairTerm(ti, Yap_GetFromSlot(sl)));
}
_findclose(hFile);
#elif HAVE_OPENDIR
{
DIR *de;
struct dirent *dp;
if ((de = opendir(buf)) == NULL) {
PlIOError(PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in list_directory",
strerror(errno));
return false;
}
while ((dp = readdir(de))) {
Term ti = MkAtomTerm(Yap_LookupAtom(dp->d_name));
Yap_PutInSlot(sl, MkPairTerm(ti, Yap_GetFromSlot(sl)));
}
closedir(de);
}
#endif /* HAVE_OPENDIR */
}
tf = Yap_GetFromSlot(sl);
return Yap_unify(ARG2, tf);
}
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 YAP_Term add_key_i(const char *key, YAP_Int v, YAP_Term o0) {
YAP_Term tkv[2];
tkv[1] = MkIntegerTerm(v), tkv[0] = MkStringTerm(key);
Term node = Yap_MkApplTerm(FunctorEq, 2, tkv);
return MkPairTerm(node, o0);
}
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;
}
