libicl_private.c

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

  else {
    return FALSE;
  }
}

/****************************************************************************
 * name:    icl_stIsStr
 * purpose: Returns true if the term is an atom
 * inputs:
 *   - char *s: a string containing a prolog term
 * returns:
 *   True if the term is an atom
 * Note: this assumes no leading or trailing whitespace in s.
 * This is defined in accordance with QP 3.1 manual, section G.1-1-3.
 ****************************************************************************/
EXPORT_MSCPP
int EXPORT_BORLAND 
icl_safeStIsStr(char *s, size_t len)
{
  char *p;
  
  if ((s == 0) || (*s == 0))
    return FALSE;

  if(len == 0) {
    return FALSE;
  }

  /* 4 special cases */
  if (strcmp(s, "!") == 0 || strcmp(s, ";") == 0)
    return TRUE;

  /* Why ???? DG
     if (strcmp(s, "[]") == 0 || strcmp(s, "{}") == 0)
     return TRUE;
  */

  /* Any sequence of chars delimited by single quotes */
  if ((*s == '\'') && (s[len-1] == '\''))
    return TRUE;

  /* Any sequence of these chars: +-*^<>=`-:.?@#$&/\ */
  if (strchr("+-*/\\^<>=`-:.?@#$&", *s) != NULL) {
    /* Using *p is still okay, because if this is an icldataq, */
    /* we fail before the binary data */
    for (p = s + 1 ; *p ; ++p) {
      if (strchr("+-*/\\^<>=`-:.?@#$&", *p) == NULL)
        return FALSE;
    }
    return TRUE;
  }

  /* Any sequence of alphanumeric or '_' starting with a lowercase letter */
  if (islower(*s)) {
    /* Using *p is still okay, because if this is an icldataq, */
    /* we fail early before the binary data */
    for (p = s + 1 ; *p ; ++p) {
      if ((isalnum(*p) == FALSE) && (*p != '_'))
        return FALSE;
    }
    return TRUE;
  }

  return FALSE;
}


/****************************************************************************
 * name:    icl_safeStIsGroup
 * purpose: Returns true if the term is a group (list of terms delimited by
 *	    {} or ().
 *          A list (delimited by []) is not considered a group.
 * inputs:
 *   - char *s: a string containing a prolog term
 * returns:
 *   True if the term is a group
 ****************************************************************************/
EXPORT_MSCPP
int EXPORT_BORLAND 
icl_safeStIsGroup(char *s, size_t len)
{
  int result = FALSE;

  if(len < 2) {
    return FALSE;
  }

  result =  (s && (
              ((*s == '{') && (s[len-1] == '}')) ||
              ((*s == '(') && (s[len-1] == ')'))));

  return result;
}


/****************************************************************************
 * name:    icl_stIsStruct
 * purpose: Returns true if the term is a struct (in form "a(...)")
 * inputs:
 *   - char *s: a string containing an icl term
 * returns:
 *   True if the term is a struct
 ****************************************************************************/
EXPORT_MSCPP
int EXPORT_BORLAND 
icl_safeStIsStruct(char *s, size_t len)
{
  char *p;

  if (!s || !*s) return FALSE;

  if(len < 3) {
    return FALSE;
  }

  p = strstr(s, "(");

  if (p && (s[len-1] == ')')) {
    char *func = malloc(p - s + 2);
    int res;
    strncpy(func, s, p - s);
    func[p-s] = '\0';
    res = icl_stIsStr(func);
    icl_stFree(func);
    return (res);
  }
  else return FALSE;
}


/****************************************************************************
 * name:    icl_stIsList
 * purpose: Returns true if the term is a list (in form [1,2,3])
 * inputs:
 *   - char *s: a string containing a prolog term
 * returns:
 *   True if the term is a list
 ****************************************************************************/
EXPORT_MSCPP
int EXPORT_BORLAND 
icl_safeStIsList(char *s, size_t len)
{
  int result = FALSE;

  if(len < 2) {
    return FALSE;
  }

  result =  (s && (*s == '[') && (s[len-1] == ']'));

  return result;
}


/****************************************************************************
 * name:    icl_safeStRemoveQuotes
 * purpose: Removes leading and trailing ' and " marks
 * inputs:
 *   - char *s: a string containing prolog terms
 * outputs:
 *   - char *s: the string minus leading and trailing quotes
 ****************************************************************************/
EXPORT_MSCPP
void EXPORT_BORLAND 
icl_safeStRemoveQuotes(char *s, size_t len, size_t* newLen)
{
  if ((*s == '\'') || (*s == '"')) {
    memmove(s, &s[1], (len - 1) * sizeof(char));
    --len;
  }
  /* One beyond length of data should be null char */
  s[len] = '\0';
  if ((s[len-1] == '\'') || (s[len-1] == '"'))
    s[len-1] = '\0';
  *newLen = len;
}

/****************************************************************************
 * name:    icl_stGroupToTerms
 * purpose: Converts an incoming ICL group into
 *          a list of terms, on which we can use list_len, NthElt, etc.
 *          i.e. a comma-separated (or otherwise separated) list 
 *	    "elt1, elt2, etl3".
 *          Basically, just removes the outer delimiters
 * inputs/outputs:
 *   - char *s: a list in prolog canonical syntax
 * remarks:
 *   icl_stGroupToTerms overwrites old value with the new because the new value
 *   is guaranteed to be shorter.
 ****************************************************************************/
EXPORT_MSCPP
void EXPORT_BORLAND 
icl_safeStGroupToTerms(char *s, size_t len, size_t* newLen)
{
  int err = 0;
 
  if (s && (*s) && (len > 0) && ((*s == '{') || (*s == '('))) {
    memmove(s, &s[1], len - 1);
    --len;
  }
  else {
    err = 1;
  }
  if (s && (*s) && (len > 0) && ((s[len - 1] == '}') || (s[len - 1] == ')'))) {
    s[len - 1] = '\0';
    --len;
  }
  else {
    err = 1;
  }

  *newLen = len;
 
  /*
    if (err) printf("Error in icl_stListToTerms() -- invalid list:\n  '%s'\n",s);
  */
}

/****************************************************************************
 * name:    icl_stListToTerms
 * purpose: Converts an incoming prolog list [elt1, elt2, elt3] form) into
 *          a list of terms, on which we can use list_len, NthElt, etc.
 *          i.e. a comma-separated list "elt1, elt2, etl3".
 *          Basically, just removes the brackets...
 * inputs/outputs:
 *   - char *s: a list in prolog canonical syntax
 * remarks:
 *   icl_stListToTerms overwrites old value with the new because the new value
 *   is guaranteed to be shorter.
 ****************************************************************************/
EXPORT_MSCPP
void EXPORT_BORLAND 
icl_safeStListToTerms(char *s, size_t len, size_t* newLen)
{
  int err = 0;
 
  if (s && (*s) && (len > 0) && (*s == '[')) {
    memmove(s, &s[1], len - 1);
    --len;
  }
  else {
    err = 1;
  }
  if (s && (*s) && (len > 0) && (s[len - 1] == ']')) {
    s[len - 1] = '\0';
    --len;
  }
  else err = 1;

  *newLen = len;
 
  /*
    if (err) printf("Error in icl_stListToTerms() -- invalid list:\n  '%s'\n",s);
  */
}

/****************************************************************************
 * name:    icl_member_strlist
 * purpose: Finds an element in a string list
 * inputs:
 *   - char *elt: The element to look for
 *   - char *slist[]: The list to look through
 *   - int  incr: Increment if not found
 *   - int  case_ins: if true, case insensitive comparison
 * returns:
 *   Position in list if found, -1 if not found
 ****************************************************************************/
int icl_member_strlist(char *elt,
                       struct dyn_array strlist,
                       int incr,
                       int case_ins)
{
  int p = 0, r;

  for (p = 0; p < strlist.count; p += incr) {
    if (case_ins) 
      r = strcasecmp(elt,strlist.item[p]);
    else
      r = strcmp(elt,strlist.item[p]);
    if (r == 0)
      return p;	/* found! */
  }
  return -1;
}


/****************************************************************************
 * name:    icl_free_dyn_list
 * purpose: Frees all elements and space used by a dynamic array
 ****************************************************************************/
void icl_free_dyn_list(struct dyn_array *slist)
{
  int i;

  for (i = 0; i < (*slist).count; i++) {
    free((*slist).item[i]);
  }
  free((*slist).item);
  slist = NULL;
}

/****************************************************************************
 * name:    icl_append_dyn_array
 * purpose: Adds an element to the end of a dynamic array
 * inputs:
 *   - char *slist[]: the list
 *   - void *str: the element to add
 * remarks:
 *   Uses realloc to increase list size if necessary
 ****************************************************************************/
void icl_append_dyn_array(struct dyn_array *slist,
                          void *str)
{
  /* Size by which to increment buffer if overflow */
  int INC_SIZE = 100;

  if (slist->count == slist->allocated) {
    if (slist->allocated == 0) {
      slist->item = malloc(INC_SIZE * sizeof(str));
    }
    else {
      slist->item = realloc(slist->item, 
                            (slist->count + INC_SIZE) * sizeof(str));
    }
    slist->allocated += INC_SIZE;
  }
  slist->item[slist->count] = str;
  slist->count++;
}

/****************************************************************************
 * name:    icl_safeStUndoubleQuotes
 * purpose: Converts any '' marks inside a string to just '
 *          Single quotes inside strings will be doubled when coming from Prolog
 * inputs:
 *   - char *s: a string containing prolog terms
 * outputs:
 *   - char *s: the string with all '' --> '
 ****************************************************************************/
void icl_safeStUndoubleQuotes(char* t, size_t len, size_t* newLen) 
{
  char c, cc, *in_ptr, *out_ptr;
  size_t current = 0;
  /* Use copy in case newLen == &len */
  size_t inLen = len;
 
  in_ptr = t;
  out_ptr = t;
  *newLen = 0;
 
  while(current < inLen) {
    c = *in_ptr;
    ++current;
    ++in_ptr;
    /* look ahead--this is okay since t is NULL terminated */
    cc = *in_ptr;
    if (c == '\'' && cc == c) {
      *out_ptr++ = c;
      ++in_ptr;
    } else {
      *out_ptr++ = c;
    }
    ++*newLen;
  }
  *out_ptr++ = '\0';  
}