libicl_depr.c

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

#include <string.h>
#include <stdio.h>
#include <ctype.h>
#include "libicl_depr.h"
#include "libicl_private.h"

#define EXPORT_BORLAND 

#ifdef IS_DLL
#define EXPORT_MSCPP __declspec(dllexport)  
#else
#define EXPORT_MSCPP
#endif

/****************************************************************************
 * name:    icl_stChunkTerm
 * purpose: takes a list of terms (comma separated) and returns the first (car)
 *          and rest (cdr) of the list.
 * inputs:
 *   - char *terms: a list of prolog terms
 * outputs:
 *   - char     *aterm: the first term in the list
 *   - char *restterms: the rest of the terms
 * remarks:
 *   - Terms may be nested arbitrarily deep (eg. a(b(c(d,1)), X).
 *   - aterm will return a new copy of the first argument, which should
 *     be free'd when finished using.  restterms will return a pointer
 *     into terms.
 *   - Term can correctly parse expression with embedded arguments using
 *     Japanese JIS7 format.  JIS7 is the Japanese encoding standard chosen
 *     for use with the OAA.  Three reasons for this choice:  1) it's the
 *     most popular standard on UNIX machines.  2) 7-bit encoding should
 *     be TCP/IP and modem friendly.  3) it's easy to parse: JIS7 embeds
 *     Japanese characters in a quotation-like wrapper, using ESC$B for the
 *     opening marker and ESC(B for the closing.
 * returns: 
 *     TRUE if a term was read, FALSE if a complete term could not be read.
 *     In the latter case, aterm and restterms returns "" as well.
 ****************************************************************************/
EXPORT_MSCPP
int EXPORT_BORLAND icl_stTerm(char *terms,
                              char **aterm,
                              char **restterms)
{
  int len = strlen(terms);
  int i;
  int n;
  int done = FALSE;
  int inquotes = FALSE;
  int inJIS7 = FALSE;
  int parens = 0;
  int seen_something = FALSE;
  *aterm = NULL;
  *restterms = NULL;

  i = -1;
  while ((i < len-1) && !done) {
    i++;

    /* Check for JIS7 Japanese Encoding markers */
    if ((terms[i] == 27) && (terms[i+1] == '$') && (terms[i+2] == 'B'))
      inJIS7 = TRUE;
    else
      if ((terms[i] == 27) && (terms[i+1] == '(') && (terms[i+2] == 'B'))
        inJIS7 = FALSE;
  
    /* If we are not looking at Japanese characters, try to parse the 
       input. */
    if (!inJIS7)
      switch (terms[i]) {
      case '(':
      case '[':
      case '{':
        if (!inquotes)
          parens = parens + 1;
        break;
      case ')':
      case ']':
      case '}':
        if (!inquotes) {
          parens = parens - 1;
          if (parens == 0)
            done = TRUE;
        }
        break;
      case '\'':
        inquotes = !inquotes;
        break;
      case ',' :
        if ((parens == 0) && (inquotes == 0))
          done = TRUE;
        break;
      case ' ':
      case '\n':
      case '\t':
        if ((parens == 0) && (inquotes == 0) && seen_something)
          done = TRUE;
        break;
      default: seen_something = TRUE;
      }
  } /* End while */

  if ((i >= 0) && !parens && !inquotes) {
    if (terms[i] == ',')
      n = i;
    else n = i+1;

    *aterm = malloc(n+1);
    strncpy(*aterm, terms, n);
    (*aterm)[n] = '\0';
    i++;
    while ((terms[i] != 0) && ((terms[i] == ' ') || (terms[i] == ',')))
      i++;
    *restterms = &terms[i];
    return TRUE;
  }
  else {
    *aterm = strdup("");
    *restterms = strdup("");
    return FALSE;
  } 
}

/****************************************************************************
 * name:    icl_stNthArg
 * purpose: Returns the Nth argument in a structure
 * inputs:
 *   - char *structure: in the form func(a1,a2,...)
 *   - int      n: argument number to return (1 is first argument)
 * outputs:
 *   - char  *argument: the nth argument in the structure. eg (a2 if n = 2)
 * remarks:
 *   icl_stNthArg will return a new copy of the argument, which should be
 *   be free'd when finished using.
 ****************************************************************************/
EXPORT_MSCPP
void EXPORT_BORLAND 
icl_stNthArg(char *structure,
             int n,
             char **argument)
{
  /* Local string vars */
  char *functor = NULL;
  char *args = NULL;

  icl_stFunctorArgs(structure, &functor, &args);
  icl_stNthElt(args, n, argument);

  /* Free local string vars */
  icl_stFree(functor);
  icl_stFree(args);
}


/****************************************************************************
 * name:    icl_stNthArgAsInt
 * purpose: Returns the nth argument in a term as integer
 * inputs:
 *   - char *structure: a prolog-style term:  eg   func(a1,a2,...)
 *   - int      n: index into a structure (nth term)
 * returns:
 *   - int   the nth argument in the structure as an integer
 ****************************************************************************/
EXPORT_MSCPP
int EXPORT_BORLAND 
icl_stNthArgAsInt(char *structure,
                  int n)
{
  char *elt = NULL;

  icl_stNthArg(structure, n, &elt);
  n = atoi(elt);
  icl_stFree(elt);
  return n;
}


/****************************************************************************
 * name:    icl_stFloat
 * purpose: Returns a float parsed from a string in ICL format.
 *          Floats may be either in the form 3.25E+2 or 325.0
 * remarks: If not valid, returns 0.0.  Can be checked with icl_stIsFloat.
 ****************************************************************************/
EXPORT_MSCPP
double EXPORT_BORLAND 
icl_stFloat(char *arg)
{
  double f, pow, tens;
  int e;
  char *p;

  f = strtod(arg, &p);
  if (p == arg)		/* Failure */
    return (0.0);

  if (*p == 'E') {
    *p = '\0';
    if (*(p+1) == '+')
      tens = 10.0;
    else 
      if (*(p+1) == '-')
        tens = 0.1;
      else return(0.0);		/* Failure */
    e = atoi(p + 2);
  }
  else {
    e = 0;
    tens = 1.0;
  }

  pow = 1.0;
  while (e > 0) {
    pow = pow * tens;
    e = e - 1;
  }
  f = f * pow;
  return f;
}


/****************************************************************************
 * name:    icl_stListLen
 * purpose: Returns the length of a comma separated list of terms
 * inputs:
 *   - char *list: list of prolog terms
 * returns:
 *   the number of elements in the list
 ****************************************************************************/
EXPORT_MSCPP
int EXPORT_BORLAND icl_stListLen(char *list)
{
  int count = 0;
  char *ATerm = NULL;
 
  while (list && *list) {
    icl_stHeadTailPtr(list, &ATerm, &list);
    icl_stFree(ATerm);
    count = count + 1;
  }
  return count;
}


/****************************************************************************
 * name:    icl_collect_vars
 * purpose: Collects all unique vars in a term into a strlist
 * remarks: 
 *    - Returns the stringlist of vars/bindings which must be deallocated
 *      when finished (free_dyn_list).
 ****************************************************************************/
static
void icl_collect_vars(char *term,
                      struct dyn_array *vars)
{
  /* Dynamically allocated vars */
  char *fun1 = NULL;
  char *args1 = NULL;
  char *elt1 = NULL;

  /* These vars do not need to be deallocated, as they 
     are not dynamically allocated */
  char *p1;

  icl_stFunctorArgs(term, &fun1, &args1);
  icl_stTrim(fun1);

  if (icl_stIsVar(term)) {
    /* Anonymous variable "_" never gets bound */
    if (vars && (strcmp(fun1,"_") != 0) && 
        (icl_member_strlist(fun1,*vars,2,0) == -1)) /* not already in list */
      icl_stbind_var(fun1, fun1, vars);  	       /* bind var to itself */
    goto done;
  }

  if (icl_stIsList(fun1) && (strcmp(fun1,"[]") != 0)) {
    args1 = strdup(fun1);
    icl_stListToTerms(args1);
  }
  p1 = args1;
  if (*args1) {
    while ((strcmp(p1, "") != 0)) {
      icl_stHeadTailPtr(p1, &elt1, &p1);
      icl_collect_vars(elt1,vars);
      icl_stFree(elt1);
    }
  }

 done:
  icl_stFree(fun1);
  icl_stFree(args1);
  icl_stFree(elt1);
}

/****************************************************************************
 * name:    icl_rename_vars
 * purpose: Renames all unique vars in a term to "_NUM" format.
 * remarks: Used by asserts to get around variable name collisions
 ****************************************************************************/
void icl_rename_vars(char *term,
                     char **new_term)
{
  struct dyn_array vars;
  int i;

  icl_init_dyn_array(&vars);

  icl_collect_vars(term, &vars);

  /* Replace var values by "_NUM" format */
  for (i=1; i < vars.count; i = i + 2) {
    icl_stFree(vars.item[i]);
    vars.item[i] = malloc(5);
    sprintf(vars.item[i], "_%d", i/2+1);
  }

  icl_stderef_term(term, new_term, vars);

  icl_free_dyn_list(&vars);
}

/*****************************************************************************
 * String-based Unification functions
 *****************************************************************************/

/****************************************************************************
 * name:    icl_stbind_var
 * purpose: Stores a var/value pair in stringlist vars
 * inputs:
 *   - char *var: Variable name
 *   - char *value: Value
 *   - dyn_array vars: string list of var/value bindings
 * remarks: 
 ****************************************************************************/
void icl_stbind_var(char *var,
                    char *value,
                    struct dyn_array *vars)
{
  icl_append_dyn_array(vars, strdup(var));
  icl_append_dyn_array(vars, strdup(value));
}



/****************************************************************************
 * name:    icl_stderef