liboaa.c

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

          /* addr(FacAddr, Id) */
          if (icl_IsStruct(Addr) && STREQ(icl_Str(Addr),"addr")) {
            ICLTerm *res, *fid;
            int arity = icl_NumTerms(Addr);

            if (com_GetInfo("parent",
                            (t1 = icl_NewStruct("addr",
                                                1,
                                                icl_NewVar("Addr"))),
                            &res)) {

              icl_Free(t1);
              if ((arity == 1) && icl_Unify(Addr, res, NULL)) {
                if (com_GetInfo("parent",
                                (t1 = icl_NewStruct("fac_id",
                                                    1,
                                                    icl_NewVar("FId"))),
                                &fid)) {

                  result = icl_CopyTerm(icl_NthTerm(fid, 1));
                  // need to icl_Free() result below...
                  freeResult = TRUE;
                  icl_Free(fid);
                  icl_Free(t1);
                }
              } 
              else {
                icl_Free(t1);
              }

              if ((arity == 2) && icl_Unify(icl_NthTerm(Addr,1),
                                            icl_NthTerm(res,1), NULL)) {
                result = icl_NthTerm(Addr, 2);
                // don't free result below...
                freeResult = FALSE;
              }
              icl_Free(res);
            }
            icl_Free(t1);

            if ((!result) && (icl_NumTerms(Addr) == 2)) {
              result = Addr;
              // don't free result below...
              freeResult = FALSE;
            }
          } 
            /* Here the incoming address may be a name and has to be left as is.
               -- name(Name)
            */
          else if (icl_IsStruct(Addr) && STREQ(icl_Str(Addr),"name")) {
              if (icl_name(icl_NthTerm(Addr, 1)))
                result = Addr;
                // don't free result below...
                freeResult = FALSE;
          } 
          else if (icl_name(Addr)) {
                result = icl_NewStruct("name", 1, icl_CopyTerm(Addr));
                // need to icl_Free() result below...
                freeResult = TRUE;
                printf("WARNING (liboaa.c): addressee name, in address/1 param, should be "
                       "specified as:\n  name(%s)\n", icl_Str(Addr));
          } 
          else if (!icl_true_id(Addr, &result)) {
                  printf("WARNING (liboaa.c): Illegal addressee, in address/1 param, discarded:\n   ");
                  icl_WriteTerm(Addr);
                  printf("\n");
                  icl_Free(result);
                  // don't need to free result again below...
                  freeResult = FALSE;
          }

  if (result)
    *StandardAddr = icl_CopyTerm(result);

  returnValue = (result != NULL) ? 1 : 0;

  if (freeResult) {
    icl_Free(result);
  }

  icl_Free(tempRequest);

  return (returnValue);
} // end of icl_standardize_addressee



/**
 * Standardizes an address or address list,
 * Can only be used after oaa_Register() because of the reliance on
 * com_GetInfo().
 */
int
icl_standardize_address(ICLTerm *Addr, ICLTerm **StandardAddr)
{
  ICLListType *args = NULL, *newArgs = NULL, *endp = NULL;
  ICLTerm *elt = NULL, *standard = NULL;

  if (!icl_IsList(Addr))
    elt = Addr;
  else
    args = icl_List(Addr);

  while (args || elt) {

    if (!elt) elt = args->elt;

    if (icl_standardize_addressee(elt, &standard)) {
      /* Keep: add to result list */
      if (!newArgs) {
        newArgs = icl_NewCons(standard, NULL);
        endp = newArgs;
      }
      else {
        endp->next = icl_NewCons(standard, NULL);
        endp = endp->next;
      }
    }

    if (args)
      args = args->next;
    elt = NULL;
  }
  if (args)
    *StandardAddr = icl_NewList(newArgs);
  else {
    *StandardAddr = newArgs->elt;

    /* Must free (iclListType *)newArgs and any elements in that list */
    if (newArgs->next == (ICLListType *)NULL)
      free(newArgs);
    else {
      ICLListType *list = newArgs->next, *next;

      free(newArgs);
      while (list) {
        icl_Free(list->elt);
        next = list->next;
        free(list);
        list = next;
      }
    }
  }

  return TRUE;
}




/**
 * Convert between shorthand and standard forms of solvables list.
 *
 * <p><b>Remarks:</b></p>
 * <ul>
 *     <li>In the standard form, each element is a term solvable(Goal,
 *       Params, Permissions), with Permissions and Params both lists.
 *       In the Permissions and Params lists, values appear only when they
 *       are OTHER than the default.</li>
 *     <li>In the shorthand form, each element can be solvable/3, as above,
 *       or solvable(Goal, Params), or solvable(Goal), or just Goal.</li>
 *     <li>Note that "shorthand" means "anything goes" - so shorthand
 *       solvables are a superset of standard solvables.</li>
 *     <li>Permissions (defaults in square brackets):
 *         call(T_F) [true], read(T_F) [false], write(T_F) [false]</li>
 *     <li>Params (defaults in square brackets):</li>
 *         <ul>
 *         <li>type(Data_Procedure) [procedure]</li>
 *         <li>callback(Functor) [user:oaa_AppDoEvent]</li>
 *         <li>utility(N) [5]</li>
 *         <li>synonym(SynonymHead, RealHead) [none]</li>
 *         <li>rules_ok(T_F) [false]</li>
 *         <li>single_value(T_F) [false]</li>
 *         <li>unique_values(T_F) [false]</li>
 *         <li>private(T_F) [false]</li>
 *         <li>bookkeeping(T_F) [true]</li>
 *         <li>persistent(T_F) [false]</li>
 *         </ul></li>
 *     <li>Refer to Agent Library Reference Manual for details on Permissions
 *       and Params.</li>
 * </ul>
 *
 * <p>Note: in the C version, an additional arg (toStandard) is added to
 * 	distinguish between the two calling conventions:</p>
 * <pre>
 *    icl_ConvertSolvables(TRUE, +ShorthandSolvables, -StandardSolvables).
 *
 *    icl_ConvertSolvables(FALSE, +StandardSolvables, -ShorthandSolvables).
 * </pre>
 *
 */
/*     - (@@DLM) This might be the place to check the validity of solvables,
 *       such as using only built-ins in tests.  Also, check for dependencies
 *       between solvables; e.g., when persistent(false) is there,
 *       bookkeeping(true) must also be there.
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_ConvertSolvables(int toStandard,
		     ICLTerm *ShorthandSolvables, ICLTerm **StandardSolvables)
{
  if (toStandard) {
    return icl_standardize_solvables(ShorthandSolvables, StandardSolvables);
  }
  else {
    return icl_readable_solvables(ShorthandSolvables, StandardSolvables);
  }
}

int
icl_standardize_solvable(ICLTerm *Shorthand,
                         ICLTerm **Standard)
{
  int isStruct = icl_IsStruct(Shorthand);
  int arity = icl_NumTerms(Shorthand);
  int res = TRUE;
  ICLTerm *tmp;
  ICLTerm *perms, *params;

  *Standard = NULL;
  /* solvable(Goal), solvable(Goal,Params), solvable(Goal,Params,Perms) */
  /* Goal may be simple or (G :- Test) */
  if (isStruct && STREQ(icl_Str(Shorthand), "solvable")) {
    ICLTerm *goal = icl_NthTerm(Shorthand, 1);

    if (arity > 1) {
      icl_standardize_params(icl_NthTerm(Shorthand, 2), FALSE, &params);
    }
    else {
      params = icl_NewList(NULL);
    }

    if (arity == 3) {
      icl_standardize_perms(icl_NthTerm(Shorthand, 3), FALSE, &perms);
    }
    else {
      perms = icl_NewList(NULL);
    }

    /* Handles all cases where goal is (Goal :- Test) */
    if (icl_IsStruct(goal) && (icl_NumTerms(goal) == 2) &&
        STREQ(icl_Str(goal), ":-")) {

      ICLTerm *g = icl_CopyTerm(icl_NthTerm(goal, 1));
      icl_AddToList(params,
		    icl_NewStruct("test", 1,
				  icl_CopyTerm(icl_NthTerm(goal, 2))), FALSE);

      tmp = icl_NewStruct("solvable", 3, g, params, perms);
      res = icl_standardize_solvable(tmp, Standard);
      icl_Free(tmp);
    }
    else {	/* Normal "simple" goal */
      *Standard = icl_NewStruct("solvable", 3,
				icl_CopyTerm(icl_NthTerm(Shorthand, 1)), params, perms);
    }
  }
  else if (isStruct && (arity == 2) && STREQ(icl_Str(Shorthand), ":-")) {
    /* (Goal :- Test) */
    ICLTerm *goal = icl_NthTerm(Shorthand, 1);

    *Standard =
      icl_NewStruct("solvable", 3, icl_CopyTerm(icl_NthTerm(goal, 1)),
		    icl_NewList(icl_NewCons(icl_CopyTerm(icl_NthTerm(goal, 2)), NULL)),
		    icl_NewList(NULL));
  }
  else {	/* goal */
    *Standard = icl_NewStruct("solvable", 3, icl_CopyTerm(Shorthand),
			      icl_NewList(NULL), icl_NewList(NULL));
  }
  return res;
}

/**
 * Renders solvables in canonical form.
 */
int
icl_standardize_solvables(ICLTerm *ShorthandSolvables,
			  ICLTerm **StandardSolvables)
{

  if (icl_IsList(ShorthandSolvables)) {
    ICLListType *args, *newArgs = NULL, *endp = NULL;
    ICLTerm *standard = NULL;

    args = icl_List(ShorthandSolvables);
    while (args) {
      if (icl_standardize_solvable(args->elt, &standard)) {
        /* Keep: add to result list */
        if (!newArgs) {
          newArgs = icl_NewCons(standard, NULL);
          endp = newArgs;
        }
	else {
	  endp->next = icl_NewCons(standard, NULL);
	  endp = endp->next;
	}
      }

      args = args->next;
    }
    *StandardSolvables = icl_NewList(newArgs);

    return TRUE;
  }
  return FALSE;
}

/**
 * Convert a single solvable into shorthand notation.
 */
/*
 * remarks:
 *    icl_readable_solvable(solvable(Goal, [], []), Goal).
 *    icl_readable_solvable(solvable(Goal, Params, []), solvable(Goal, Params)).
 *    icl_readable_solvable(solvable(Goal, Params, Perms),
 *                       solvable(Goal, Params, Perms)).
 */
int
icl_readable_solvable(ICLTerm *StandardSolvable,
		      ICLTerm **ShorthandSolvable)
{
  int isStruct = icl_IsStruct(StandardSolvable);
  int arity = icl_NumTerms(StandardSolvable);

  if (isStruct && (arity == 3) &&
      STREQ(icl_Str(StandardSolvable),"solvable")) {
    ICLTerm *params = icl_NthTerm(StandardSolvable, 2);
    ICLTerm *perms  = icl_NthTerm(StandardSolvable, 2);

    if (icl_IsList(perms) && (icl_NumTerms(perms) == 0)) {
      if (icl_IsList(params) && (icl_NumTerms(params) == 0))
        *ShorthandSolvable = icl_CopyTerm(icl_NthTerm(StandardSolvable,1));
      else
        *ShorthandSolvable = icl_NewStruct("solvable", 2,
                                           icl_CopyTerm(icl_NthTerm(StandardSolvable,1)),
                                           icl_CopyTerm(icl_NthTerm(StandardSolvable,2)));
    }
    else
      *ShorthandSolvable = icl_CopyTerm(StandardSolvable);
  }
  else
    *ShorthandSolvable = icl_CopyTerm(StandardSolvable);
  return TRUE;
}


/**
 * This is provided for use in "pretty-printing" solvables,
 * in trace messages, etc.
 */
int
icl_readable_solvables(ICLTerm *StandardSolvables,
                       ICLTerm **ShorthandSolvables)
{
  if (icl_IsList(StandardSolvables)) {
    ICLListType *args, *newArgs = NULL, *endp = NULL;
    ICLTerm *shortsolve = NULL;

    args = icl_List(StandardSolvables);
    while (args) {

      if (icl_readable_solvable(args->elt, &shortsolve)) {
        /* Keep: add to result list */
        if (!newArgs) {
          newArgs = icl_NewCons(shortsolve, NULL);
          endp = newArgs;
        }
        else {
          endp->next = icl_NewCons(shortsolve, NULL);
          endp = endp->next;
        }
      }

      args = args->next;
    }
    *ShorthandSolvables = icl_NewList(newArgs);
    return TRUE;
  }
  else return FALSE;
}



/**
 * Convert from shorthand (or standard form) to minimally instantiated
 * solvables list.
 * <p><b>Remarks:</b></p>
 * <ul>
 *     <li>This is special-purpose. It's used to massage a list of solvables
 *      that are to be UNdeclared, to make sure each of them will unify
 *      with some existing solvable.  Perms and Params are completely
 *      ignored in the unification; only the