This commit is contained in:
Vitor Santos Costa 2016-09-21 14:32:29 -05:00
parent 2f885bb6f3
commit 3845d4e67d

185
C/args.c
View File

@ -2,22 +2,18 @@
#include "Yap.h" #include "Yap.h"
#include "Yatom.h" #include "Yatom.h"
/**
* Scan a list of arguments and output results to a pre-processed vector.
/** *
* Scan a list of arguments and output results to a pre-processed vector.
*
* @param listl: input list * @param listl: input list
* @param def parameter definition * @param def parameter definition
* *
* @return all arguments, some of them set, some of them not. * @return all arguments, some of them set, some of them not.
*/ */
static xarg * static xarg *matchKey(Atom key, xarg *e0, int n, const param_t *def) {
matchKey(Atom key, xarg *e0, int n, const param_t *def)
{
int i; int i;
for (i=0; i< n; i++) { for (i = 0; i < n; i++) {
if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) { if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) {
return e0; return e0;
} }
@ -31,11 +27,9 @@ matchKey(Atom key, xarg *e0, int n, const param_t *def)
* Returns the index of an argument key, or -1 if not found. * Returns the index of an argument key, or -1 if not found.
* *
*/ */
int int Yap_ArgKey(Atom key, const param_t *def, int n) {
Yap_ArgKey(Atom key, const param_t *def, int n)
{
int i; int i;
for (i=0; i< n; i++) { for (i = 0; i < n; i++) {
if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) { if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) {
return i; return i;
} }
@ -46,105 +40,95 @@ Yap_ArgKey(Atom key, const param_t *def, int n)
#define failed(e, t, a) failed__(e, t, a PASS_REGS) #define failed(e, t, a) failed__(e, t, a PASS_REGS)
static xarg * static xarg *failed__(yap_error_number e, Term t, xarg *a USES_REGS) {
failed__( yap_error_number e, Term t, xarg *a USES_REGS) free(a);
{
free( a );
LOCAL_Error_TYPE = e;
LOCAL_Error_Term = t;
return NULL; return NULL;
} }
xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n) {
xarg *
Yap_ArgListToVector (Term listl, const param_t *def, int n)
{
CACHE_REGS CACHE_REGS
listl = Deref(listl); listl = Deref(listl);
xarg *a = calloc( n , sizeof(xarg) ); xarg *a = calloc(n, sizeof(xarg));
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule) if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule)
listl = ArgOfTerm(2,listl); listl = ArgOfTerm(2, listl);
if (!IsPairTerm(listl) && listl != TermNil) { if (!IsPairTerm(listl) && listl != TermNil) {
if (IsVarTerm(listl) ) { if (IsVarTerm(listl)) {
return failed( INSTANTIATION_ERROR, listl, a); return failed(INSTANTIATION_ERROR, listl, a);
} }
if (IsAtomTerm(listl) ) { if (IsAtomTerm(listl)) {
xarg *na = matchKey( AtomOfTerm(listl), a, n, def); xarg *na = matchKey(AtomOfTerm(listl), a, n, def);
if (!na) { if (!na) {
return failed( TYPE_ERROR_LIST, listl, a ); return failed(TYPE_ERROR_LIST, listl, a);
} }
} else if (IsApplTerm(listl)) { } else if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm( listl ); Functor f = FunctorOfTerm(listl);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
return failed( TYPE_ERROR_LIST, listl, a); return failed(TYPE_ERROR_LIST, listl, a);
} }
arity_t arity = ArityOfFunctor( f ); arity_t arity = ArityOfFunctor(f);
if (arity != 1) { if (arity != 1) {
return failed( TYPE_ERROR_LIST, listl, a); return failed(TYPE_ERROR_LIST, listl, a);
} }
xarg *na = matchKey( NameOfFunctor( f ), a, n, def); xarg *na = matchKey(NameOfFunctor(f), a, n, def);
if (!na) { if (!na) {
return failed( TYPE_ERROR_LIST, listl, a); return failed(TYPE_ERROR_LIST, listl, a);
} }
na->used = true; na->used = true;
na->tvalue = ArgOfTerm(1,listl); na->tvalue = ArgOfTerm(1, listl);
return a; return a;
} else { } else {
return failed( TYPE_ERROR_LIST, listl, a); return failed(TYPE_ERROR_LIST, listl, a);
} }
listl = MkPairTerm( listl, TermNil ); listl = MkPairTerm(listl, TermNil);
} }
while (IsPairTerm(listl)) { while (IsPairTerm(listl)) {
Term hd = HeadOfTerm( listl ); Term hd = HeadOfTerm(listl);
listl = TailOfTerm( listl ); listl = TailOfTerm(listl);
if (IsVarTerm(hd) || IsVarTerm(listl)) { if (IsVarTerm(hd) || IsVarTerm(listl)) {
if (IsVarTerm(hd)) { if (IsVarTerm(hd)) {
return failed( INSTANTIATION_ERROR, hd, a); return failed(INSTANTIATION_ERROR, hd, a);
} else { } else {
return failed( INSTANTIATION_ERROR, listl, a); return failed(INSTANTIATION_ERROR, listl, a);
} }
} }
if (IsAtomTerm(hd)) { if (IsAtomTerm(hd)) {
xarg *na = matchKey( AtomOfTerm( hd ), a, n, def); xarg *na = matchKey(AtomOfTerm(hd), a, n, def);
if (!na) if (!na)
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a); return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
na->used = true; na->used = true;
na->tvalue = TermNil; na->tvalue = TermNil;
continue; continue;
} else if (IsApplTerm( hd )) { } else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm( hd ); Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
return failed( TYPE_ERROR_PARAMETER, hd, a); return failed(TYPE_ERROR_PARAMETER, hd, a);
} }
arity_t arity = ArityOfFunctor( f ); arity_t arity = ArityOfFunctor(f);
if (arity != 1) { if (arity != 1) {
return failed( DOMAIN_ERROR_OUT_OF_RANGE, hd, a); return failed(DOMAIN_ERROR_OUT_OF_RANGE, hd, a);
} }
xarg *na = matchKey( NameOfFunctor( f ), a, n, def); xarg *na = matchKey(NameOfFunctor(f), a, n, def);
if (!na) { if (!na) {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a); return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
} }
na->used = true; na->used = true;
na->tvalue = ArgOfTerm(1, hd); na->tvalue = ArgOfTerm(1, hd);
} else { } else {
return failed( TYPE_ERROR_PARAMETER, hd, a); return failed(TYPE_ERROR_PARAMETER, hd, a);
} }
} }
if (IsVarTerm(listl)) { if (IsVarTerm(listl)) {
return failed( INSTANTIATION_ERROR, listl, a); return failed(INSTANTIATION_ERROR, listl, a);
} else if (listl != TermNil) { } else if (listl != TermNil) {
return failed( TYPE_ERROR_LIST, listl, a); return failed(TYPE_ERROR_LIST, listl, a);
} }
return a; return a;
} }
static xarg * static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) {
matchKey2(Atom key, xarg *e0, int n, const param2_t *def)
{
int i; int i;
for (i=0; i< n; i++) { for (i = 0; i < n; i++) {
if (!strcmp((char*)def->name, (char*)RepAtom(key)->StrOfAE)) { if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) {
return e0; return e0;
} }
def++; def++;
@ -153,82 +137,79 @@ matchKey2(Atom key, xarg *e0, int n, const param2_t *def)
return NULL; return NULL;
} }
/// Yap_ArgList2ToVector is much the same as before, /// Yap_ArgList2ToVector is much the same as before,
/// but assumes parameters also have something called a /// but assumes parameters also have something called a
/// scope /// scope
xarg * xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n) {
Yap_ArgList2ToVector (Term listl, const param2_t *def, int n)
{
CACHE_REGS CACHE_REGS
xarg *a = calloc( n , sizeof(xarg) ); xarg *a = calloc(n, sizeof(xarg));
if (!IsPairTerm(listl) && listl != TermNil) { if (!IsPairTerm(listl) && listl != TermNil) {
if (IsVarTerm(listl) ) { if (IsVarTerm(listl)) {
return failed( INSTANTIATION_ERROR, listl, a); return failed(INSTANTIATION_ERROR, listl, a);
} }
if (IsAtomTerm(listl) ) { if (IsAtomTerm(listl)) {
xarg *na = matchKey2( AtomOfTerm(listl), a, n, def); xarg *na = matchKey2(AtomOfTerm(listl), a, n, def);
if (!na) { if (!na) {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a); return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
} }
} }
if (IsApplTerm(listl)) { if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm( listl ); Functor f = FunctorOfTerm(listl);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
return failed( TYPE_ERROR_PARAMETER, listl, a); return failed(TYPE_ERROR_PARAMETER, listl, a);
} }
arity_t arity = ArityOfFunctor( f ); arity_t arity = ArityOfFunctor(f);
if (arity != 1) { if (arity != 1) {
return failed( TYPE_ERROR_LIST, listl, a); return failed(TYPE_ERROR_LIST, listl, a);
} }
xarg *na = matchKey2( NameOfFunctor( f ), a, n, def); xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
if (!na) { if (!na) {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a); return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
} }
} else { } else {
return failed( TYPE_ERROR_LIST, listl, a); return failed(TYPE_ERROR_LIST, listl, a);
} }
listl = MkPairTerm( listl, TermNil ); listl = MkPairTerm(listl, TermNil);
} }
while (IsPairTerm(listl)) { while (IsPairTerm(listl)) {
Term hd = HeadOfTerm( listl ); Term hd = HeadOfTerm(listl);
if (IsVarTerm(hd)) { if (IsVarTerm(hd)) {
return failed( INSTANTIATION_ERROR, hd, a); return failed(INSTANTIATION_ERROR, hd, a);
} }
if (IsAtomTerm(hd)) { if (IsAtomTerm(hd)) {
xarg *na = matchKey2( AtomOfTerm( hd ), a, n, def); xarg *na = matchKey2(AtomOfTerm(hd), a, n, def);
if (!na) { if (!na) {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a); return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
} }
na->used = true; na->used = true;
na->tvalue = TermNil; na->tvalue = TermNil;
continue; continue;
} else if (IsApplTerm( hd )) { } else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm( hd ); Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
return failed( TYPE_ERROR_PARAMETER, hd, a); return failed(TYPE_ERROR_PARAMETER, hd, a);
} }
arity_t arity = ArityOfFunctor( f ); arity_t arity = ArityOfFunctor(f);
if (arity != 1) { if (arity != 1) {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a); return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
} }
xarg *na = matchKey2( NameOfFunctor( f ), a, n, def); xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
if (na) { if (na) {
na->used = 1; na->used = 1;
na->tvalue = ArgOfTerm(1, hd); na->tvalue = ArgOfTerm(1, hd);
} else { } else {
return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a); return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
} }
} else { } else {
return failed( INSTANTIATION_ERROR, hd, a); return failed(INSTANTIATION_ERROR, hd, a);
} }
listl = TailOfTerm(listl); listl = TailOfTerm(listl);
} }
if (IsVarTerm(listl)) { if (IsVarTerm(listl)) {
return failed( INSTANTIATION_ERROR, listl, a); return failed(INSTANTIATION_ERROR, listl, a);
} }
if (TermNil != listl) { if (TermNil != listl) {
return failed( TYPE_ERROR_LIST, listl, a); return failed(TYPE_ERROR_LIST, listl, a);
} }
return a; return a;
} }