libicl.c

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

    elt, pc, n);

    if(n > 100) {
    char* abort = 0;
    fprintf(stderr, "icl_FreeTerm suspicious recursion number; aborting\n");
    abort[0] = 1;
    }

    if(decRes < 0) {
    char* abort = 0;
    fprintf(stderr, "icl_FreeTerm duplicate free; aborting\n");
    abort[0] = 1;
    }
  */

  if (icl_IsValid(elt)) {

    if ((elt->iclType == icl_int_type) ||
        (elt->iclType == icl_float_type) ||
        (elt->iclType == icl_var_type) ||
        (elt->iclType == icl_str_type) ||
        (elt->iclType == icl_dataq_type)) {
      if(elt->glibAlloc == 1) {
        g_free(elt->p);
      }
      else {
        free(elt->p);		/* frees space allocated by pointer */
        elt->p = NULL;
      }
    }
    else

      if (elt->iclType == icl_struct_type) {
        ICLStructType *st = elt->p;
        free(st->name);
        st->name = NULL;
        icl_FreeTermMulti(st->args, n + 1, pc);
        free(elt->p);
        elt->p = NULL;
      }
      else

        if (elt->iclType == icl_list_type) {
          ICLListType *list = elt->p;
          ICLListType *next;
          while (list) {
	    icl_FreeTermMulti(list->elt, n + 1, pc);
	    next = list->next;
            memset(list, 0, sizeof(ICLListType));
	    free(list);
	    list = next;
          }
          elt->p = NULL;
        }

    if (elt->iclType == icl_group_type) {
      ICLGroupType *gp = elt->p;
      ICLListType *list = gp->list;
      ICLListType *next;
      free(gp->separator);
      gp->separator = NULL;
      while (list) {
        icl_FreeTermMulti(list->elt, n + 1, pc);
        next = list->next;
        list->next = NULL;
        memset(list, 0, sizeof(ICLListType));
        free(list);
        list = next;
      }
      free(gp);
      elt->p = NULL;
    }

    memset(elt, 0, sizeof(ICLTerm));
    elt->magic_cookie = 0xdeadbeef;
    elt->iclType = icl_no_type;
    free(elt);
#ifdef NORMAL_GC
    CHECK_LEAKS();
#endif
  }
}

#if 0

/****************************************************************************
 * name:    icl_ReuseMem
 * purpose: A very simple form of garbage collection for ICLTerms.
 *    Often, a programmer wants to create a "temporary" ICL structure to
 *    pass to some procedure, such that the life of the structure needs only
 *    exist during that call.  icl_ReuseMem can be used for this purpose, to
 *    recover the memory for a temporary structure.
 * remarks:
 *    icl_ReuseMem keeps a static pointer of the last structure passed which
 *    it will free to make room for the next structure coming in.  Therefore,
 *    the "life expectancy" of a structure passed to icl_ReuseMem is only
 *    until the next call to this function.
 * warning:
 *    Do not use this function twice in the same call, since the second call
 *    will erase the value of the first (see above)
 *     ie. WRONG!!!
 *        do(icl_ReuseMem(icl_NewStr("a")), icl_ReuseMem(icl_NewStr("b")));
 ****************************************************************************/
EXPORT_MSCPP
ICLTerm * EXPORT_BORLAND
icl_ReuseMem(ICLTerm *elt)
{
  static ICLTerm *last = NULL;

  icl_Free(last);
  last = elt;
  return elt;
}

#endif


/****************************************************************************
 * Structure testing routines
 ****************************************************************************/

/**
 * Returns TRUE if object is of type List.
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_IsList(ICLTerm *elt)
{
  return (icl_IsValid(elt) && (elt->iclType == icl_list_type));
}

/**
 * Returns TRUE if object is of type Group.
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_IsGroup(ICLTerm *elt)
{
  return (icl_IsValid(elt) && (elt->iclType == icl_group_type));
}

/**
 * Returns TRUE if object is of type Struct.
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_IsStruct(ICLTerm *elt)
{
  return (icl_IsValid(elt) && (elt->iclType == icl_struct_type));
}


/**
 * Returns TRUE if object is of type Str.
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_IsStr(ICLTerm *elt)
{
  return (icl_IsValid(elt) && (elt->iclType == icl_str_type));
}


/**
 * Returns TRUE if object is of type Var.
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_IsVar(ICLTerm *elt)
{
  return (icl_IsValid(elt) && (elt->iclType == icl_var_type));
}


/**
 * Returns TRUE if object is of type Int.
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_IsInt(ICLTerm *elt)
{
  return (icl_IsValid(elt) && (elt->iclType == icl_int_type));
}


/**
 * Returns TRUE if object is of type Float.
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_IsFloat(ICLTerm *elt)
{
  return (icl_IsValid(elt) && (elt->iclType == icl_float_type));
}

EXPORT_MSCPP
int EXPORT_BORLAND
icl_IsDataQ(ICLTerm* elt)
{
  return (icl_IsValid(elt) && (elt->iclType == icl_dataq_type));
}


/**
 * Returns TRUE if object is valid.
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_IsValid(ICLTerm *elt)
{
  return (elt && (elt->magic_cookie == ICL_MAGIC_COOKIE));
}

/*****************************************************************************
 * name: icl_IsGround
 * purpose:
 *****************************************************************************/

int icl_IsGround(ICLTerm *term)
{
  ICLListType *plist = (ICLListType *)NULL;

  if (! icl_IsValid(term))
    return FALSE;

  if(icl_IsVar(term))
    return FALSE;

  if(icl_IsStruct(term))
    plist = icl_Arguments(term);
  else if(icl_IsList(term))
    plist = icl_List(term);

  /* ??? check for any other complex types? */

  while(icl_ListHasMoreElements(plist)) {
    ICLTerm *el = icl_ListElement(plist);

    if(!icl_IsGround(el))
      return FALSE;
    plist = icl_ListNextElement(plist);
  }
  return TRUE;
}

/**
 * Get the data associated with this ICLTerm if it is of type
 * icl_dataq_type.
 *
 * @return a pointer to the data, or NULL
 * @see icl_dataq_type
 */
EXPORT_MSCPP
void* EXPORT_BORLAND
icl_DataQ(ICLTerm* elt)
{
  if(icl_IsDataQ(elt)) {
    return elt->p;
  }
  else {
    return NULL;
  }
}

EXPORT_MSCPP
size_t EXPORT_BORLAND
icl_DataQLen(ICLTerm* elt)
{
  if(icl_IsDataQ(elt)) {
    return elt->len;
  }
  else {
    return 0;
  }
}

/**
 * Returns 0 if invalid.
 */
EXPORT_MSCPP
size_t EXPORT_BORLAND
icl_Len(ICLTerm* elt)
{
  if(icl_IsValid(elt)) {
    return elt->len;
  }
  else {
    return 0;
  }
}

/**
 * Returns the value for an ICL int.
 * If not valid, returns 0.
 */
EXPORT_MSCPP
gint64 EXPORT_BORLAND
icl_Int(ICLTerm *elt)
{
  gint64 *i;

  if (icl_IsInt(elt)) {
    i = elt->p;
    return (*i);
  }
  else return(0);
}


/**
 * Returns the value for an ICL float.
 * If not valid, returns 0.0.
 */
EXPORT_MSCPP
double EXPORT_BORLAND
icl_Float(ICLTerm *elt)
{
  double *f;

  if (icl_IsFloat(elt)) {
    f = elt->p;
    return (*f);
  }
  else return(0.0);
}


/**
 * Returns the value for an ICL str, struct (functor), or an ICL var
 * (returns name). If not valid, returns NULL.
 * Otherwise returns a pointer to the true string value, which should
 * <em>not</em> be deallocated or changed!!!
 */
EXPORT_MSCPP
char * EXPORT_BORLAND
icl_Str(ICLTerm *elt)
{
  if (icl_IsStr(elt) || icl_IsVar(elt))
    return((char*)(elt->p));
  else
    if (icl_IsStruct(elt)) {
      ICLStructType *st = elt->p;
      return(st->name);
    }
    else return(NULL);
}

/**
 * Returns the functor for an ICL struct.
 * If not valid, returns NULL.
 * Otherwise returns a pointer to the true string value, which should
 * <em>not</em> be deallocated or changed!!!
 */
EXPORT_MSCPP
char * EXPORT_BORLAND
icl_Functor(ICLTerm *elt)
{
  if (icl_IsStruct(elt)) {
    ICLStructType *st = elt->p;
    return(st->name);
  }
  else {
    return(NULL);
  }
}


/**
 * Returns a pointer to the list of arguments for an ICL structure.
 * If not valid, returns NULL.
 */
EXPORT_MSCPP
ICLListType * EXPORT_BORLAND
icl_Arguments(ICLTerm *elt)
{
  if (icl_IsStruct(elt)) {
    ICLStructType *st = elt->p;
    return(icl_List(st->args));
  }
  else return(NULL);
}

/**
 * Returns the start character and separators for a group.
 * If not valid group, returns FALSE.
 * <p>example:</p>
 * <pre>
 *   {a ; b ; c}  returns '{' and ";"
 * </pre>
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_GetGroupChars(ICLTerm *group, char *startC, char **sep)
{
  if (icl_IsGroup(group)) {
    ICLGroupType *gt = group->p;
    *startC = gt->startChar;
    *sep = strdup(gt->separator);
    return(TRUE);
  }
  else return(FALSE);
}


/**
 * Returns a pointer to the list of elements for an ICL list.
 * If not valid, returns NULL. Also works for an icl_Struct
 * (equivalent to icl_Arguments) or an icl_Group.
 */
EXPORT_MSCPP
ICLListType * EXPORT_BORLAND
icl_List(ICLTerm *elt)
{
  if (icl_IsList(elt)) {
    ICLListType *list = elt->p;
    return(list);
  }
  else
    if (icl_IsGroup(elt)) {
      ICLGroupType *gp = elt->p;
      ICLListType *list = gp->list;
      return(list);
    }
    else
      if (icl_IsStruct(elt)) {
        ICLStructType *st = elt->p;
        return(icl_List(st->args));
      }
      else return(NULL);
}

EXPORT_MSCPP
ICLListType *  EXPORT_BORLAND icl_ListNext(ICLListType* t)
{
  return t->next;
}

EXPORT_MSCPP
ICLTerm *  EXPORT_BORLAND icl_ListElt(ICLListType* t)
{
  return t->elt;
}


ICLListType* icl_copy_listtype(ICLListType* l)
{
  ICLListType* newList = NULL;
  ICLListType* prev = NULL;
  while(l) {
    newList = (ICLListType*)malloc(sizeof(ICLListType));
    if(prev != NULL) {
      prev->next = newList;
    }
    newList->next = NULL;
    newList->elt = icl_CopyTerm(l->elt);
    l = l->next;
    prev = newList;
  }
  return newList;
}

/**
 * Returns a pointer to the list of elements for an ICL list.
 * If not valid, returns NULL. Also works for an icl_Struct
 * (equivalent to icl_Arguments) or an icl_Group.
 */
EXPORT_MSCPP
ICLListType * EXPORT_BORLAND
icl_ListCopy(ICLTerm *elt)
{
  if (icl_IsList(elt)) {
    ICLListType *list = elt->p;
    return(icl_copy_listtype(list));
  }
  else
    if (icl_IsGroup(elt)) {
      ICLGroupType *gp = elt->p;
      ICLListType *list = gp->list;
      return(icl_copy_listtype(list));
    }
    else
      if (icl_IsStruct(elt)) {
        ICLStructType *st = elt->p;
        return(icl_copy_listtype(icl_List(st->args)));
      }
      else {
        return(NULL);
      }
}


/****************************************************************************
 * List manipulation
 ****************************************************************************/

/**
 * Adds an object at the beginning or the end of the list or a group.
 * @return TRUE if the object can be added
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_AddToList(ICLTerm *list, ICLTerm *elt, int atEnd)
{
  if (icl_IsValid(elt) && (icl_IsList(list) || icl_IsGroup(list)) ) {

    /* Empty list */
    if (icl_IsList(list) && !list->p) {
      list->p = icl_NewCons(elt, NULL);
      return TRUE;
    }
    else {
      /* at beginning */
      if (!atEnd) {
	list->p = icl_NewCons(elt, list->p);
      }
      else {
	/* Group of one elt ??  */
	if (icl_IsGroup(list) && (!((ICLGroupType*)list->p)->list))
	  ((ICLGroupType *)list->p)->list = icl_NewCons(elt, NULL);

	/* l