yap-6.3/C/args.c

#include "Yap.h"
#include "Yatom.h"



/** 
 * Scan a list of arguments and output results to a pre-processed vector. 
 * 
 * @param listl: input list
 * @param def parameter definition
 * 
 * @return all arguments, some of them set, some of them not.
 */

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;
}

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;
}              

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;
}


/// 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) ) {
	free( a );
	LOCAL_Error_TYPE = INSTANTIATION_ERROR;
	LOCAL_Error_Term = listl;
	return NULL;
      }
    if (IsAtomTerm(listl) ) {
      xarg *na = matchKey2( AtomOfTerm(listl), a, n, def);
      if (!na) {
	free( a );
	LOCAL_Error_TYPE = TYPE_ERROR_LIST;
	LOCAL_Error_Term = listl;
	return NULL;
      }
    }
    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 = matchKey2( 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 );
    if (IsVarTerm(hd))  {
      LOCAL_Error_TYPE = INSTANTIATION_ERROR;
      free( a );
      return NULL;
    }
    if (IsAtomTerm(hd)) {
      xarg *na = matchKey2( AtomOfTerm( hd ), a, n, def);
      if (!na) {
	LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE;
	LOCAL_Error_Term = hd;
	free( a );
	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 = matchKey2( NameOfFunctor( f ), a, n, def);
      if (na) {
	na->used = 1;
	na->tvalue = ArgOfTerm(1, hd);
      }
    } else {
      LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
      LOCAL_Error_Term = hd;
      free( a );
      return NULL;    
    }
    listl = TailOfTerm(listl);
  }
  if (IsVarTerm(listl))  {
    LOCAL_Error_TYPE = INSTANTIATION_ERROR;
    free( a );
    return NULL;
  }
  if (TermNil != listl) {
    LOCAL_Error_TYPE = TYPE_ERROR_LIST;
    LOCAL_Error_Term = listl;
    free( a );
    return NULL;
  }
  return a;
}