args.c

Go to the documentation of this file.

 
#include "Yap.h"
#include "Yatom.h"
#include "amiops.h"
 
static xarg *matchKey(Atom key, xarg *e0, int n, const param_t *def) {
  int i;
  for (i = 0; i < n; i++) {
    if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) {
      return e0;
    }
    def++;
    e0++;
  }
  return NULL;
}
 
int Yap_ArgKey(Atom key, const param_t *def, int n) {
  int i;
  for (i = 0; i < n; i++) {
    if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) {
      return i;
    }
    def++;
  }
  return -1;
}
 
#define YAP_XARGINFO(Error, Message)
 
 
xarg *Yap_ArgListToVector__(const char *file, const char *function, int lineno,
                            Term listl, const param_t *def, int n,
                xarg *a,
                            yap_error_number err) {
  CACHE_REGS
    listl = Deref(listl);
  if (IsVarTerm(listl)) {
    Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl,
                     "while opening    listl = ArgOfTerm(2, listl ,k)");
  }
   if (!a)
    a = calloc(n, sizeof(xarg));
 
  if (!IsPairTerm(listl) && listl != TermNil) {
    if (IsAtomTerm(listl)) {
      xarg *na = matchKey(AtomOfTerm(listl), a, n, def);
      if (!na) {
        Yap_ThrowError__(file, function, lineno, err, listl, "match key");
      }
    } else if (IsApplTerm(listl)) {
      Functor f = FunctorOfTerm(listl);
      if (IsExtensionFunctor(f)) {
        Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "callable");
      }
      arity_t arity = ArityOfFunctor(f);
      if (arity != 1) {
        Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad arity");
      }
      xarg *na = matchKey(NameOfFunctor(f), a, n, def);
      if (!na) {
        Yap_ThrowError__(file, function, lineno, err, listl, "no match");
      }
      na->used = true;
      na->tvalue = ArgOfTerm(1, listl);
    } else {
      Yap_ThrowError__(file, function, lineno, TYPE_ERROR_ATOM, listl, "not atom");
    }
    listl = MkPairTerm(listl, TermNil);
  }
  while (IsPairTerm(listl)) {
    Term hd = HeadOfTerm(listl);
    listl = TailOfTerm(listl);
    if (IsVarTerm(hd)) {
      Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "sub-element");
    }
    if (IsVarTerm(listl)) {
      Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "sub-list");
    }
    if (IsAtomTerm(hd)) {
      xarg *na = matchKey(AtomOfTerm(hd), a, n, def);
      if (!na)
        Yap_ThrowError__(file, function, lineno, err, hd, "bad match in list");
      na->used = true;
      na->tvalue = TermNil;
      continue;
    } else if (IsApplTerm(hd)) {
      Functor f = FunctorOfTerm(hd);
      if (IsExtensionFunctor(f)) {
        Yap_ThrowError__(file, function, lineno, err, hd, "bad compound");
      }
      arity_t arity = ArityOfFunctor(f);
      if (arity != 1) {
        Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_OUT_OF_RANGE, hd,
                         "high arity");
      }
      xarg *na = matchKey(NameOfFunctor(f), a, n, def);
      if (!na) {
        Yap_ThrowError__(file, function, lineno, err, hd, "no match");
      }
      na->used = true;
      na->tvalue = ArgOfTerm(1, hd);
    } else {
      Yap_ThrowError__(file, function, lineno, err, hd, "bad type");
    }
  }
  if (IsVarTerm(listl)) {
    Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "unbound");
  } else if (listl != TermNil) {
    Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad list");
  }
  return a;
  }
 
static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) {
  int i;
  for (i = 0; i < n; i++) {
    if (!strcmp((char *)def->name, (char *)RepAtom(key)->StrOfAE)) {
      return e0;
    }
    def++;
    e0++;
  }
  return NULL;
}
xarg *Yap_ArgList2ToVector__(const char *file, const char *function, int lineno,Term listl, const param2_t *def, int n, yap_error_number err) {
  CACHE_REGS
  xarg *a = calloc(n, sizeof(xarg));
  if (!IsPairTerm(listl) && listl != TermNil) {
    if (IsVarTerm(listl)) {
      Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "unbound");
    }
    if (IsAtomTerm(listl)) {
      xarg *na = matchKey2(AtomOfTerm(listl), a, n, def);
      if (!na) {
        Yap_ThrowError__(file, function, lineno, err,
                         listl, "bad match");
      }
    }
    if (IsApplTerm(listl)) {
      Functor f = FunctorOfTerm(listl);
      if (IsExtensionFunctor(f)) {
        Yap_ThrowError__(file, function, lineno, TYPE_ERROR_PARAMETER, listl,
                         "bad compound");
      }
      arity_t arity = ArityOfFunctor(f);
      if (arity != 1) {
        Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad arity");
      }
      xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
      if (!na) {
        Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
                         listl, "bad match");
      }
    } else {
      Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "");
    }
    listl = MkPairTerm(listl, TermNil);
  }
  while (IsPairTerm(listl)) {
    Term hd = HeadOfTerm(listl);
    if (IsVarTerm(hd)) {
      Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "");
    }
    if (IsAtomTerm(hd)) {
      xarg *na = matchKey2(AtomOfTerm(hd), a, n, def);
      if (!na) {
        Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
                         hd, "bad match");
      }
      na->used = true;
      na->tvalue = TermNil;
      continue;
    } else if (IsApplTerm(hd)) {
      Functor f = FunctorOfTerm(hd);
      if (IsExtensionFunctor(f)) {
        Yap_ThrowError__(file, function, lineno, TYPE_ERROR_PARAMETER, hd, "bad compound");
      }
      arity_t arity = ArityOfFunctor(f);
      if (arity != 1) {
        Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
                         hd, "bad arity");
      }
      xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
      if (na) {
        na->used = 1;
        na->tvalue = ArgOfTerm(1, hd);
      } else {
        Yap_ThrowError__(file, function, lineno, err,
                         hd, "bad key");
      }
      return a;
    } else {
      Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "unbound");
    }
    listl = TailOfTerm(listl);
  }
  if (IsVarTerm(listl)) {
    Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "");
  }
  if (TermNil != listl) {
    Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "");
  }
  return a;
}