libicl_depr.c

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

 * purpose: See if a variable can be resolved using existing variable bindings
 * inputs:
 *   - char *var: will return value if one can be found in var_bindings
 *   - char *var_bindings[]:
 *	        A list stored with var/value in l[N]/l[N+1]
 * remarks: 
 *   quits program!
 ****************************************************************************/
void icl_stderef(char **var,
                 struct dyn_array var_bindings)
{
  int done = 0;
  int pos;

  do {
    pos = icl_member_strlist(*var, var_bindings, 2, 0);
    if (pos >= 0) {
      icl_stFree(*var);
      *var = strdup(var_bindings.item[pos+1]);
    }
    else done = 1;
  } while (!done);
}


/****************************************************************************
 * name:    icl_stderef_term
 * purpose: replace all variables in a term by their bindings
 * inputs:
 *   - char *t, t2: terms to match (unify)
 *   - char ***vars: a string list where variable bindings will be stored
 *	    during unification.  If vars is NULL, no var bindings are kept,
 *	    acting as a simple match instead of a true unify.
 * remarks: 
 *    - Returns the stringlist of vars/bindings which must be deallocated
 *      when finished (free_dyn_list).
 ****************************************************************************/
void icl_stderef_term(char *term,
                      char **answer,
                      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;
  char openp[2], closep[2];

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

  icl_stderef(&fun1,vars);

  if (icl_stIsList(fun1) && (strcmp(fun1,"[]") != 0)) {
    args1 = strdup(fun1);
    icl_stListToTerms(args1);
    strcpy(openp, "[");
    strcpy(closep, "]");
  }
  else
    if (icl_stIsGroup(fun1)) {
      args1 = strdup(fun1);
      icl_stGroupToTerms(args1);
      strcpy(openp, "[");
      strcpy(closep, "]");
      openp[0] = fun1[0];
      closep[0] = fun1[strlen(fun1)-1];
    }
    else {
      icl_stAppend(answer, fun1);
      strcpy(openp, "(");
      strcpy(closep, ")");
    }
  p1 = args1;
  if (*args1) {
    icl_stAppend(answer, openp);
    while ((strcmp(p1, "") != 0)) {
      icl_stHeadTailPtr(p1, &elt1, &p1);
      icl_stderef_term(elt1,answer,vars);
      if (*p1)
        icl_stAppend(answer, ",");
      icl_stFree(elt1);
    }
    icl_stAppend(answer, closep);
  }

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

/****************************************************************************
 * name:    icl_stmatch_terms
 * purpose: Returns true if Term1 matches Term2, saving variable bindings
 *          as it goes (if requested)
 * inputs:
 *   - char *t, t2: terms to match (unify)
 *   - dyn_array *vars: a string list where variable bindings will be stored
 *	    during unification.  If vars is NULL, no var bindings are kept,
 *	    acting as a simple match instead of a true unify.
 * remarks: 
 *    - Returns the stringlist of vars/bindings which must be deallocated
 *      when finished (free_dyn_list).
 ****************************************************************************/
static
int icl_stmatch_terms(char *t1,
                      char *t2,
                      struct dyn_array *vars)
{
  /* Dynamically allocated vars */
  char *fun1 = NULL;
  char *fun2 = NULL;
  char *args1 = NULL;
  char *args2 = NULL;
  char *elt1 = NULL;
  char *elt2 = NULL;

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

  int result = TRUE;

  icl_stFunctorArgs(t1, &fun1, &args1);
  icl_stFunctorArgs(t2, &fun2, &args2);

  icl_stTrim(fun1);
  icl_stTrim(fun2);

  if (vars) {
    icl_stderef(&fun1,*vars);
    icl_stderef(&fun2,*vars);
  }

  if (icl_stIsVar(fun1)) {
    /* Anonymous variable "_" never gets bound */
    if (vars)
      /* && (strcmp(fun1,"_") != 0) && (strcmp(fun1, fun2) != 0))*/
      icl_stbind_var(fun1, fun2, vars);
    goto done;
  } else
    if (icl_stIsVar(fun2)) {
      /* Anonymous variable "_" never gets bound */
      if (vars)
	/* && (strcmp(fun2,"_") != 0) && (strcmp(fun1, fun2) != 0))*/
        icl_stbind_var(fun2, fun1, vars);
      goto done;
    } else {

      /* If both are [A,B,C] style lists, remove brackets
	 and start unifying args.  functors are set to "." */
      /* Works the same for (A,B,C) and {A,B,C}.  */
      if ((icl_stIsGroup(fun1) || icl_stIsList(fun1)) && 
	  (icl_stIsGroup(fun2) || icl_stIsList(fun2)) &&
	  (*fun1 == *fun2)) {
        args1 = strdup(fun1);
        args2 = strdup(fun2);
        icl_stGroupToTerms(args1);
        icl_stGroupToTerms(args2);
        icl_stFree(fun1);
        icl_stFree(fun2);
        fun1 = strdup(".");
        fun2 = strdup(".");
      }

      icl_stRemoveQuotes(fun1);
      icl_stRemoveQuotes(fun2);
      if (strcmp(fun1, fun2) == 0) {   /* same functor */

        p1 = args1;
        p2 = args2;
        while ((strcmp(p1, "") != 0) && (strcmp(p2, "") != 0)) {
          icl_stHeadTailPtr(p1, &elt1, &p1);
          icl_stHeadTailPtr(p2, &elt2, &p2);
          if (!icl_stmatch_terms(elt1, elt2, vars)) {
            result = FALSE;
            goto done;
          }
	       
          icl_stFree(elt1);
          icl_stFree(elt2);
        }
        if ((*p1 != 0) || (*p2 != 0)) {
          result = FALSE;
          goto done;
        }
      }
      else {
        result = FALSE;
        goto done;
      }
    }

 done:
  icl_stFree(fun1);
  icl_stFree(fun2);
  icl_stFree(args1);
  icl_stFree(args2);
  icl_stFree(elt1);
  icl_stFree(elt2);

  return result; 
   
}



/****************************************************************************
 * name:    icl_stUnify
 * purpose: Perform true unification and return resulting term
 * returns: if the two terms unify, returns true and answer will contain 
 *	    the unified term. Otherwise returns false (answer not changed)
 * remarks: 
 *   - If unification is successful, answer will be created in a new
 *     space which should be icl_stFree'd when done using.
 *   - answer may be NULL, in which case the resulting term is not returned
 *     but unify will still return true or false
 *   - unify() only works for simple prolog structures.  The following do
 *     NOT work:
 *        o Expressions using operators,  eg: A = 2, A -> B | C.
 ****************************************************************************/
EXPORT_MSCPP
int EXPORT_BORLAND icl_stUnify(char *term1,
                               char *term2,
                               char **answer)
{
  struct dyn_array da;
  int result;

  icl_init_dyn_array(&da);

  result = icl_stmatch_terms(term1, term2, &da);
  if (result && answer)
    icl_stderef_term(term1, answer, da);

  icl_free_dyn_list(&da);
  return result;
}


/****************************************************************************
 * 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_stListToTerms(char *s)
{
  int err = 0;
 
  if (s && (*s) && (*s == '['))
    strcpy(s, &s[1]);
  else err = 1;
  if (s && (*s) && (s[strlen(s)-1] == ']'))
    s[strlen(s)-1] = '\0';
  else err = 1;
 
  /*
    if (err) printf("Error in icl_stListToTerms() -- invalid list:\n  '%s'\n",s);
  */
}

/****************************************************************************
 * name:    icl_stHeadTailPtr
 * purpose: takes a comma-separated list of elements and returns a copy of 
 *	    the first element and a pointer to the rest of the list.
 * inputs:
 *   - char *terms: a list of 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, which should NOT BE free'd.
 *   - 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_stHeadTailPtr(char *terms,
                  char **aterm,
                  char **restterms)
{
  int i;
  int n, len;
  int done = FALSE;
  int inquotes = FALSE;
  int inJIS7 = FALSE;
  int parens = 0;
  int seen_something = FALSE;

  *aterm = NULL;
  *restterms = NULL;

  len = strlen(terms);

  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) && (!icl_stIsOperatorChar(terms[i+1])))
            done = TRUE;