This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/args.c

216 lines
5.7 KiB
C
Raw Normal View History

#include "Yap.h"
#include "Yatom.h"
2016-09-21 20:32:29 +01:00
/**
* Scan a list of arguments and output results to a pre-processed vector.
*
* @param listl: input list
* @param def parameter definition
2016-09-21 20:32:29 +01:00
*
* @return all arguments, some of them set, some of them not.
*/
2016-09-21 20:32:29 +01:00
static xarg *matchKey(Atom key, xarg *e0, int n, const param_t *def) {
int i;
2016-09-21 20:32:29 +01:00
for (i = 0; i < n; i++) {
2015-09-21 23:05:36 +01:00
if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) {
return e0;
}
def++;
e0++;
}
return NULL;
}
2016-02-11 13:57:03 +00:00
/**
* Returns the index of an argument key, or -1 if not found.
*
*/
2016-09-21 20:32:29 +01:00
int Yap_ArgKey(Atom key, const param_t *def, int n) {
2016-02-11 13:57:03 +00:00
int i;
2016-09-21 20:32:29 +01:00
for (i = 0; i < n; i++) {
2016-02-11 13:57:03 +00:00
if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) {
return i;
}
def++;
}
return -1;
}
2016-02-22 13:01:09 +00:00
#define failed(e, t, a) failed__(e, t, a PASS_REGS)
2016-09-21 20:32:29 +01:00
static xarg *failed__(yap_error_number e, Term t, xarg *a USES_REGS) {
free(a);
2016-02-11 13:57:03 +00:00
return NULL;
}
2016-09-21 20:32:29 +01:00
xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n) {
2015-10-08 02:11:10 +01:00
CACHE_REGS
listl = Deref(listl);
2016-09-21 20:32:29 +01:00
xarg *a = calloc(n, sizeof(xarg));
2015-10-08 02:11:10 +01:00
if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule)
2016-09-21 20:32:29 +01:00
listl = ArgOfTerm(2, listl);
2015-10-08 02:11:10 +01:00
if (!IsPairTerm(listl) && listl != TermNil) {
2016-09-21 20:32:29 +01:00
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
2016-02-11 13:57:03 +00:00
}
2016-09-21 20:32:29 +01:00
if (IsAtomTerm(listl)) {
xarg *na = matchKey(AtomOfTerm(listl), a, n, def);
2015-10-08 02:11:10 +01:00
if (!na) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_LIST, listl, a);
2015-10-08 02:11:10 +01:00
}
} else if (IsApplTerm(listl)) {
2016-09-21 20:32:29 +01:00
Functor f = FunctorOfTerm(listl);
2015-10-08 02:11:10 +01:00
if (IsExtensionFunctor(f)) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_LIST, listl, a);
2015-10-08 02:11:10 +01:00
}
2016-09-21 20:32:29 +01:00
arity_t arity = ArityOfFunctor(f);
2015-10-08 02:11:10 +01:00
if (arity != 1) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_LIST, listl, a);
2015-10-08 02:11:10 +01:00
}
2016-09-21 20:32:29 +01:00
xarg *na = matchKey(NameOfFunctor(f), a, n, def);
2015-10-08 02:11:10 +01:00
if (!na) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_LIST, listl, a);
2015-10-08 02:11:10 +01:00
}
na->used = true;
2016-09-21 20:32:29 +01:00
na->tvalue = ArgOfTerm(1, listl);
return a;
2015-10-08 02:11:10 +01:00
} else {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_LIST, listl, a);
2015-10-08 02:11:10 +01:00
}
2016-09-21 20:32:29 +01:00
listl = MkPairTerm(listl, TermNil);
}
while (IsPairTerm(listl)) {
2016-09-21 20:32:29 +01:00
Term hd = HeadOfTerm(listl);
listl = TailOfTerm(listl);
if (IsVarTerm(hd) || IsVarTerm(listl)) {
2015-10-08 02:11:10 +01:00
if (IsVarTerm(hd)) {
2016-09-21 20:32:29 +01:00
return failed(INSTANTIATION_ERROR, hd, a);
2015-10-08 02:11:10 +01:00
} else {
2016-09-21 20:32:29 +01:00
return failed(INSTANTIATION_ERROR, listl, a);
2015-10-08 02:11:10 +01:00
}
}
if (IsAtomTerm(hd)) {
2016-09-21 20:32:29 +01:00
xarg *na = matchKey(AtomOfTerm(hd), a, n, def);
if (!na)
2016-09-21 20:32:29 +01:00
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
na->used = true;
na->tvalue = TermNil;
continue;
2016-09-21 20:32:29 +01:00
} else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_PARAMETER, hd, a);
}
2016-09-21 20:32:29 +01:00
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
2016-09-21 20:32:29 +01:00
return failed(DOMAIN_ERROR_OUT_OF_RANGE, hd, a);
}
2016-09-21 20:32:29 +01:00
xarg *na = matchKey(NameOfFunctor(f), a, n, def);
2015-11-05 16:39:34 +00:00
if (!na) {
2016-09-21 20:32:29 +01:00
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
2015-11-05 19:22:40 +00:00
}
na->used = true;
2016-09-21 20:32:29 +01:00
na->tvalue = ArgOfTerm(1, hd);
} else {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_PARAMETER, hd, a);
}
}
2015-10-08 02:11:10 +01:00
if (IsVarTerm(listl)) {
2016-09-21 20:32:29 +01:00
return failed(INSTANTIATION_ERROR, listl, a);
2015-10-08 02:11:10 +01:00
} else if (listl != TermNil) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_LIST, listl, a);
2015-10-08 02:11:10 +01:00
}
return a;
2016-09-21 20:32:29 +01:00
}
2016-09-21 20:32:29 +01:00
static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) {
int i;
2016-09-21 20:32:29 +01:00
for (i = 0; i < n; i++) {
if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) {
return e0;
}
def++;
e0++;
}
return NULL;
}
2015-08-07 22:57:53 +01:00
/// Yap_ArgList2ToVector is much the same as before,
/// but assumes parameters also have something called a
/// scope
2016-09-21 20:32:29 +01:00
xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n) {
2015-10-08 02:11:10 +01:00
CACHE_REGS
2016-09-21 20:32:29 +01:00
xarg *a = calloc(n, sizeof(xarg));
if (!IsPairTerm(listl) && listl != TermNil) {
2016-09-21 20:32:29 +01:00
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
2016-02-11 13:57:03 +00:00
}
2016-09-21 20:32:29 +01:00
if (IsAtomTerm(listl)) {
xarg *na = matchKey2(AtomOfTerm(listl), a, n, def);
2015-10-08 02:11:10 +01:00
if (!na) {
2016-09-21 20:32:29 +01:00
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
2015-10-08 02:11:10 +01:00
}
}
if (IsApplTerm(listl)) {
2016-09-21 20:32:29 +01:00
Functor f = FunctorOfTerm(listl);
2015-10-08 02:11:10 +01:00
if (IsExtensionFunctor(f)) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_PARAMETER, listl, a);
2015-10-08 02:11:10 +01:00
}
2016-09-21 20:32:29 +01:00
arity_t arity = ArityOfFunctor(f);
2015-10-08 02:11:10 +01:00
if (arity != 1) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_LIST, listl, a);
2015-10-08 02:11:10 +01:00
}
2016-09-21 20:32:29 +01:00
xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
2015-10-08 02:11:10 +01:00
if (!na) {
2016-09-21 20:32:29 +01:00
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
2015-10-08 02:11:10 +01:00
}
} else {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_LIST, listl, a);
2015-10-08 02:11:10 +01:00
}
2016-09-21 20:32:29 +01:00
listl = MkPairTerm(listl, TermNil);
}
while (IsPairTerm(listl)) {
2016-09-21 20:32:29 +01:00
Term hd = HeadOfTerm(listl);
if (IsVarTerm(hd)) {
return failed(INSTANTIATION_ERROR, hd, a);
}
if (IsAtomTerm(hd)) {
2016-09-21 20:32:29 +01:00
xarg *na = matchKey2(AtomOfTerm(hd), a, n, def);
2015-10-08 02:11:10 +01:00
if (!na) {
2016-09-21 20:32:29 +01:00
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
2015-10-08 02:11:10 +01:00
}
na->used = true;
na->tvalue = TermNil;
continue;
2016-09-21 20:32:29 +01:00
} else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_PARAMETER, hd, a);
}
2016-09-21 20:32:29 +01:00
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
2016-09-21 20:32:29 +01:00
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
}
2016-09-21 20:32:29 +01:00
xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
2015-08-07 22:57:53 +01:00
if (na) {
2016-09-21 20:32:29 +01:00
na->used = 1;
na->tvalue = ArgOfTerm(1, hd);
2016-02-11 13:57:03 +00:00
} else {
2016-09-21 20:32:29 +01:00
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
2015-08-07 22:57:53 +01:00
}
} else {
2016-09-21 20:32:29 +01:00
return failed(INSTANTIATION_ERROR, hd, a);
}
listl = TailOfTerm(listl);
2015-10-08 02:11:10 +01:00
}
2016-09-21 20:32:29 +01:00
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
2015-10-08 02:11:10 +01:00
}
2015-08-07 22:57:53 +01:00
if (TermNil != listl) {
2016-09-21 20:32:29 +01:00
return failed(TYPE_ERROR_LIST, listl, a);
}
return a;
2016-09-21 20:32:29 +01:00
}