libicl.c

来自「SRI international 发布的OAA框架软件」· C语言 代码 · 共 2,613 行 · 第 1/5 页

	}
	if(termStack.item != NULL) {
	  free(termStack.item);
	}
	return NULL;
	break;
      }
      compoundStack.item[compoundStack.count - 1] = NULL;
      compoundStack.count--;
      currCompound = (struct CompoundInfo*)compoundStack.item[compoundStack.count - 1];
      icl_add_compound_argument(currCompound, currTerm);
    }
  }
  icl_WriteTerm(currTerm);
  printf("\n");
  fprintf(stderr, "icl_copy_term_nonrec unreachable\n");
  return NULL;
}

/****************************************************************************
 * name:    icl_copy_term
 * purpose: Creates a copy of the term, all in new memory.
 *	    Dereferences variables from binding list if available
 ****************************************************************************/
/*
  EXPORT_MSCPP
  ICLTerm *EXPORT_BORLAND
  icl_copy_term(ICLTerm *t, struct dyn_array *vars)
  {
  ICLTerm *res = NULL;

  if (vars) {
  icl_deref(&t, *vars);
  }

  if (icl_IsVar(t)) {
  res = icl_NewVar(icl_Str(t));
  }
  else if (icl_IsInt(t)) {
  res = icl_NewInt(icl_Int(t));
  }
  else if (icl_IsFloat(t)) {
  res = icl_NewFloat(icl_Float(t));
  }
  else if (icl_IsStr(t)) {
  res = icl_NewStr(icl_Str(t));
  }
  else if (icl_IsStruct(t)) {
  ICLTerm *argList = icl_NewList(icl_copy_list_type(icl_Arguments(t),vars));
  res = icl_NewStructFromList(icl_Functor(t), argList);
  }
  else if (icl_IsList(t)) {
  res = icl_NewList(icl_copy_list_type(icl_List(t),vars));
  }
  else if (icl_IsGroup(t)) {
  char startC, *sep = NULL;
  icl_GetGroupChars(t, &startC, &sep);
  res = icl_NewGroup(startC, sep, icl_copy_list_type(icl_List(t), vars));
  icl_stFree(sep);
  }
  else if (t == NULL) {
  return NULL;
  }
  else {
  fprintf(stderr, "Unknown type in icl_copy_term\n");
  }

  return (res);
  }
*/

/**
 * Creates a new copy of a ListType list, dereferencing vars if available.
 */
static
ICLListType *
icl_copy_list_type(ICLListType *list, struct dyn_array *vars)
{
  ICLListType *res = NULL, *end = NULL;

  while (list) {
    if (!res) {
      ICLTerm* copy = icl_copy_term_nonrec(list->elt, vars);
      res = icl_NewCons(copy, NULL);
      end = res;
    }
    else {
      end->next = icl_NewCons(icl_copy_term_nonrec(list->elt, vars), NULL);
      end = end->next;
    }
    list = list->next;
  }

  return(res);
}



/**
 * Creates a copy of the term, all in new memory.
 */
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_CopyTerm(ICLTerm *t)
{
  return (icl_copy_term(t, NULL));
}


/**
 * Creates a new copy of a ListType list
 */
EXPORT_MSCPP
ICLListType * EXPORT_BORLAND
icl_CopyListType(ICLListType *list)
{
  return(icl_copy_list_type(list, NULL));
}



/**
 * Creates a new ICL object of type integer.
 * @param i integer value for the structure
 * @return a pointer to the new ICL object
 */
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_NewInt(gint64 i)
{
  ICLTerm *res = malloc(sizeof(ICLTerm));
  gint64 *iptr = malloc(sizeof(gint64));

  *iptr = i;
  res->iclType = icl_int_type;
  res->p = iptr;
  res->magic_cookie = ICL_MAGIC_COOKIE;
  res->len = sizeof(gint64);

  res->refCount = 1;
  res->glibAlloc = 0;
  res->hadQuotes = 0;
  return (res);
}


/**
 * Creates a new ICL object of type float
 * @param f double value for the structure
 * @return a pointer to the new ICL object
 */
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_NewFloat(double f)
{
  ICLTerm *res = malloc(sizeof(ICLTerm));
  double *fptr = malloc(sizeof(double));

  *fptr = f;
  res->iclType = icl_float_type;
  res->p = fptr;
  res->magic_cookie = ICL_MAGIC_COOKIE;
  res->len = sizeof(double);

  res->refCount = 1;
  res->glibAlloc = 0;
  res->hadQuotes = 0;
  return (res);
}


/**
 * Creates a new ICL object of type string. Uses a copy of the given string.
 * @param s string value for the structure
 * @return a pointer to the new ICL object or NULL if s is not valid
 */
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_NewStr(char *s)
{
  ICLTerm *res = NULL;

  if (s) {
    res = malloc(sizeof(ICLTerm));

    res->iclType = icl_str_type;
    res->p = strdup(s);
    res->magic_cookie = ICL_MAGIC_COOKIE;
    res->refCount = 1;
    res->glibAlloc = 0;
    res->hadQuotes = 0;
    res->len = strlen(s);
  }

  return (res);
}

ICLTerm*
icl_NewStrNoCopy(char *s)
{
  ICLTerm *res = NULL;

  if (s) {
    res = malloc(sizeof(ICLTerm));

    res->iclType = icl_str_type;
    res->p = s;
    res->magic_cookie = ICL_MAGIC_COOKIE;
    res->refCount = 1;
    res->glibAlloc = 0;
    res->hadQuotes = 0;
    res->len = strlen(s);
  }

  return (res);
}

/**
 * Creates a new ICL object of type variable.
 * @param name string value containing the name for the structure
 * @return a pointer to the new ICL object or NULL if name isn't valid
 */
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_NewVar(char *name)
{
  ICLTerm *res = NULL;

  if (name && *name) {
    res = malloc(sizeof(ICLTerm));

    res->iclType = icl_var_type;
    res->p = strdup(name);
    res->magic_cookie = ICL_MAGIC_COOKIE;
    res->refCount = 1;
    res->glibAlloc = 0;
    res->hadQuotes = 0;
    res->len = strlen(name);
  }

  return (res);
}

ICLTerm *
icl_NewVarNoCopy(char *name)
{
  ICLTerm *res = NULL;

  if (name && *name) {
    res = malloc(sizeof(ICLTerm));

    res->iclType = icl_var_type;
    res->p = name;
    res->magic_cookie = ICL_MAGIC_COOKIE;
    res->refCount = 1;
    res->glibAlloc = 0;
    res->hadQuotes = 0;
    res->len = strlen(name);
  }

  return (res);
}

/**
 * Creates a new ICL object of type structure given args as a list
 * @param functor string name for the structure
 * @param args an icl List object
 * @return a pointer to the new ICL object or NULL if invalid args or
 *         invalid functor
 */
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_NewStructFromList(char *functor, ICLTerm *args)
{
  ICLTerm       *res = NULL;
  ICLStructType *st = NULL;

  if (icl_IsList(args) && icl_stIsStr(functor)) {

    res = malloc(sizeof(ICLTerm));
    st = malloc(sizeof(ICLStructType));

    st->name = strdup(functor);
    st->numArgs = icl_NumTerms(args);
    st->args = args;

    res->iclType = icl_struct_type;
    res->p = st;
    res->magic_cookie = ICL_MAGIC_COOKIE;
    res->refCount = 1;
    res->glibAlloc = 0;
    res->hadQuotes = 0;
    res->len = sizeof(st);
  }

  return (res);
}



/**
 * Creates a new ICL object of type structure. Uses a copy of functor.
 * @param functor string name for the structure
 * @param arity the new structure's arity
 * @param ... a variable length argument list containing pointers to ICLTerms
 * @return a pointer to the new ICL object or NULL if not valid args
 */
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_NewStruct(char *functor, int arity, ...)
{
  ICLTerm *arg,  *res = NULL;

  va_list ap;	/* points to each unnamed arg in turn */
  int i=0;

  if (icl_stIsStr(functor)) {
    ICLStructType *st = malloc(sizeof(ICLStructType));
    ICLTerm *args;

    res = malloc(sizeof(ICLTerm));

    args = icl_NewList(NULL);

    /* copy args into list */
    va_start(ap, arity);	/* point ap to first unnamed arg */
    for (i=0; i< arity;i++) {
      arg = va_arg(ap, ICLTerm*);
      if (arg) {
        icl_AddToList(args, arg, TRUE);
      }
    }
    va_end(ap);

    st->name = strdup(functor);
    st->numArgs = arity;
    st->args = args;

    res->iclType = icl_struct_type;
    res->p = st;
    res->magic_cookie = ICL_MAGIC_COOKIE;
    res->refCount = 1;
    res->glibAlloc = 0;
    res->hadQuotes = 0;
    res->len = sizeof(st);
  }

  return (res);
}


/**
 * Returns a new element of ICLListType.
 */
EXPORT_MSCPP
ICLListType * EXPORT_BORLAND
icl_NewCons(ICLTerm *elt, ICLListType *tail)
{
  ICLListType *res = malloc(sizeof(ICLListType));

  res->elt = elt;
  res->next = tail;
  if(elt != NULL) {
    iclIncRef(elt);
  }

  return (res);
}

EXPORT_MSCPP
ICLTerm* EXPORT_BORLAND
icl_NewDataQ(void const* data, size_t dataLen)
{
  ICLTerm* res = malloc(sizeof(ICLTerm));
  res->p = malloc(dataLen);
  if(dataLen > 0) {
    memcpy(res->p, data, dataLen);
  }
  else {
    res->p = NULL;
  }
  res->len = dataLen;
  res->iclType = icl_dataq_type;
  res->magic_cookie = ICL_MAGIC_COOKIE;
  res->refCount = 1;
  res->glibAlloc = 0;
  res->hadQuotes = 0;

  return res;
}

ICLTerm*
icl_NewDataQNoCopy(void* data, size_t dataLen)
{
  ICLTerm* res = malloc(sizeof(ICLTerm));
  res->p = data;
  res->len = dataLen;
  res->iclType = icl_dataq_type;
  res->magic_cookie = ICL_MAGIC_COOKIE;
  res->refCount = 1;
  res->glibAlloc = 0;
  res->hadQuotes = 0;

  return res;
}

/**
 * Creates a new ICL object of type group.
 * @param startC a character which initially delimits the group (e.g. '{')
 * @param separator separator character
 * @param list a value of type list, probably returned by icl_NewCons()
 * @return a pointer to the new ICL object
 * @see icl_NewCons
 */
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_NewGroup(char startC, char *separator, ICLListType *list)
{
  ICLTerm *res = malloc(sizeof(ICLTerm));
  ICLGroupType *gp = malloc(sizeof(ICLGroupType));

  res->iclType = icl_group_type;
  gp->startChar = startC;
  gp->separator = strdup(separator);
  gp->list = list;
  res->p = gp;
  res->magic_cookie = ICL_MAGIC_COOKIE;
  res->refCount = 1;
  res->glibAlloc = 0;
  res->hadQuotes = 0;
  res->len = sizeof(gp);

  return (res);
}

/**
 * Creates a new ICL object of type list.
 * @param list a value of type list, probably returned by icl_NewCons()
 * @return a pointer to the new ICL object
 * @see icl_NewCons
 */
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_NewList(ICLListType *list)
{
  ICLTerm *res = malloc(sizeof(ICLTerm));

  res->iclType = icl_list_type;
  res->p = list;
  res->magic_cookie = ICL_MAGIC_COOKIE;
  res->refCount = 1;
  res->glibAlloc = 0;
  res->hadQuotes = 0;
  res->len = sizeof(list);

  return (res);
}


EXPORT_MSCPP
void EXPORT_BORLAND
icl_FreeTermSingle(ICLTerm *elt)
{
  /* void* pc = current_text_addr(); */
  icl_FreeTermMulti(elt,0,0);
}

EXPORT_MSCPP
void EXPORT_BORLAND
icl_FreeTerm(ICLTerm *elt)
{
  icl_FreeTermMulti(elt,0,0);
}

/**
 * Free a memory pointer (string or term) and set it to NULL afterwards.
 * @param p a variable to deallocate
 * <p><b>Remarks:</b></p>
 * <ul>
 *   <li>icl_stFree() is better than free() because it checks that you will
 *     never attempt to free a NULL variable, and you will never
 *     try to free the same variable twice, which can lead to BIG problems!</li>
 *   <!--li>icl_stFree() is defined as a macro so that it is not necessary to pass
 *     in the address of the variable you want to free, which is unnatural.</li-->
 * </ul>
 */
EXPORT_MSCPP
void EXPORT_BORLAND
icl_stFree(void *p) {
  if (p) {
#ifdef NORMAL_GC
    GC_debug_free(p); p = 0;
#else
  free(p); p = 0;
#endif
  }
}

/****************************************************************************
 * name:    icl_FreeTermMulti
 * purpose: Frees all memory used by an object ptr
 * remarks: Use icl_Free() macro, which then sets the pointer to NIL
 ****************************************************************************/
static void
icl_FreeTermMulti(ICLTerm *elt, int n, void* pc)
{
#ifdef NORMAL_GC
  CHECK_LEAKS();
#endif
  /*
    int decRes = 0;
    int i = 0;
    int max = (n > 10 ? 10 : n);
    CHECK_LEAKS();

    if(elt != NULL) {
    iclDecRef(elt);
    }

    for(i = 0; i < max; i++) {
    fprintf(stderr, "  ");
    }
    fprintf(stderr, "icl_FreeTerm on %x called from %x recursion %i\n",