liboaa.c

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

    ICLListType *slist = NULL;
    ICLListType *next = NULL;

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

      icl_param_standard_form(args->elt, &slist);

      while (slist) {
        if (KeepDefaults || !icl_param_default(slist->elt,NULL)) {
          /* Keep: add to result list */
          if (!newArgs) {
            newArgs = icl_NewCons(slist->elt, NULL);
            endp = newArgs;
          }
          else {
            endp->next = icl_NewCons(slist->elt, NULL);
            endp = endp->next;
          }
        }
        /* Free list as we go, but don't free elements
	 * Very ugly.  Be careful if you happen to be changing this.
	 */
        next = slist->next;
        free(slist);
        slist = next;
      }
      args = args->next;
    }
    *Standardized = icl_NewList(newArgs);
    return TRUE;
  }
  else {
    *Standardized = NULL;
    return FALSE;
  }
}


/**
 * Returns the list of default parameters.
 * May be used with icl_ParamValue() to test or lookup an element
 */
ICLTerm * param_default_list()
{
  static ICLTerm *param_defaults = NULL;

  /* check to see if first time or somehow invalidated */
  if (!icl_IsValid(param_defaults)) {
    param_defaults =
      icl_NewTermFromString("[from(unknown),priority(5),utility(5),if_exists(append),type(procedure),callback(app_do_event),private(false),single_value(false),unique_values(false),rules_ok(false),bookkeeping(true),persistent(false),at_beginning(false),do_all(false),reflexive(true),parallel_ok(true),reply(true),block(true),cache(false),flush_events(false),recurrence(when)]");
    return param_defaults;
  }
  else return param_defaults;
}


/**
 * Returns a copy of parameter in standard parameter form.
 */
void
icl_param_standard_form(ICLTerm *param, ICLListType **SList)
{
  int isStruct = icl_IsStruct(param);
  int arity = icl_NumTerms(param);
  if (isStruct && (arity == 1) && STREQ(icl_Str(param), "block")) {
    *SList = icl_NewCons(icl_NewStruct("blocking", 1, icl_NthTerm(param, 1)),NULL);
  }
  else if (isStruct && (arity == 1) && STREQ(icl_Str(param), "reply") &&
           STREQ(icl_Str(icl_NthTerm(param, 1)), "false")) {
    *SList = icl_NewCons(icl_NewStruct("reply", 1, icl_NewStr("none")),NULL);
  }
  else if (isStruct && (arity == 1) && STREQ(icl_Str(param), "broadcast") &&
           STREQ(icl_Str(icl_NthTerm(param, 1)), "false")) {
    *SList = icl_NewCons(icl_NewStruct("reply", 1, icl_NewStr("true")),NULL);
  }
  else if ((arity == 0) && STREQ(icl_Str(param), "broadcast")) {
    *SList = icl_NewCons(icl_NewStruct("reply", 1, icl_NewStr("none")),NULL);
  }
  else if (isStruct && (arity == 1) && STREQ(icl_Str(param), "address")) {
    ICLTerm *newAddr;
    icl_standardize_address(icl_NthTerm(param, 1), &newAddr);
    *SList = icl_NewCons(icl_NewStruct("address", 1, newAddr),NULL);
  }
  else if (isStruct && (arity == 1) && STREQ(icl_Str(param), "strategy") &&
           STREQ(icl_Str(icl_NthTerm(param, 1)), "query")) {
    *SList = icl_NewCons(icl_NewStruct("parallel_ok", 1, icl_NewStr("true")),
                         NULL);
  }
  else if (isStruct && (arity == 1) && STREQ(icl_Str(param), "strategy") &&
           STREQ(icl_Str(icl_NthTerm(param, 1)), "action")) {
    *SList = icl_NewCons(icl_NewStruct("parallel_ok", 1, icl_NewStr("false")),
                         icl_NewCons(icl_NewStruct("solution_limit", 1, icl_NewInt(1)),NULL));
  }
  else if (isStruct && (arity == 1) && STREQ(icl_Str(param), "strategy") &&
           STREQ(icl_Str(icl_NthTerm(param, 1)), "inform")) {
    *SList = icl_NewCons(icl_NewStruct("parallel_ok", 1, icl_NewStr("true")),
                         icl_NewCons(icl_NewStruct("reply", 1, icl_NewStr("none")),NULL));
  }
  else if (icl_IsStr(param)) {
    *SList = icl_NewCons(icl_NewStruct(icl_Str(param), 1, icl_NewStr("true")),
                         NULL);
  }
  else {
    *SList = icl_NewCons(icl_CopyTerm(param), NULL);
  }
}


/**
 * Returns true if param unifies with a default parameter.
 * result may be NULL (test only) or can return the result
 * of the unification.
 */
int
icl_param_default(ICLTerm *param, ICLTerm **result)
{
  return (icl_IsStruct(param) && (icl_NumTerms(param) == 1) &&
	  icl_ParamValue(icl_Str(param), icl_NthTerm(param, 1),
			 param_default_list(), result));
}

/**
 * Searches for a parameter in a parameter list.
 * Just like icl_ParamValue() except it returns the argument of the
 * result instead of the whole unified term.
 * Returns a newly allocated copy.
 */
int icl_param_arg(char *param, ICLTerm *value, ICLTerm *paramlist,
                  ICLTerm **result) {
  ICLTerm *bigresult;
  int res = FALSE;
  if(icl_ParamValue(param, value, paramlist, &bigresult)) {
    res = TRUE;
    if (bigresult) {
      *result = icl_CopyTerm(icl_NthTerm(bigresult, 1));
      icl_Free(bigresult);
    }
  }
  return res;
}

/**
 * To get or test the value of a parameter that has a default,
 * it is best to call icl_GetParamValue().
 * For a parameter that has no default, you can use icl_GetParamValue()
 * OR memberchk().
 * <p><b>Remarks:</b></p>
 * <ul>
 *     <li>Param must be a partially- or fully-instantiated structure
 *       (atom form will not work)</li>
 *     <li>Result may be NULL, in which case only a test is performed</li>
 * </ul>
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_GetParamValue(ICLTerm *Param, ICLTerm *ParamList, ICLTerm **Result)
{
  int res = FALSE;

  if (icl_IsStruct(Param) && (icl_NumTerms(Param) == 1) &&
      icl_IsList(ParamList)) {
    ICLTerm *p;

    if (icl_ParamValue(icl_Str(Param), NULL, ParamList, &p)) {
      res = icl_Unify(Param, p, Result);
      icl_Free(p);
    } else

      if (icl_ParamValue(icl_Str(Param), NULL, param_default_list(), &p)) {
        res = icl_Unify(Param, p, Result);
        icl_Free(p);
      }

    return res;
  }
  else {
    return FALSE;
  }
}

/**
 * To get or test the value of a parameter that has a default,
 * it is best to call icl_GetPermValue().
 * For a parameter that has no default, you can use icl_GetPermValue()
 * OR memberchk().
 *
 * <p><b>Remarks:</b></p>
 * <ul>
 *     <li>Perm must be a partially- or fully-instantiated structure
 *       (atom form will not work)</li>
 *     <li>Result may be NULL, in which case only a test is performed</li>
 * </ul>
 */
EXPORT_MSCPP
int EXPORT_BORLAND
icl_GetPermValue(ICLTerm *Perm, ICLTerm *PermList, ICLTerm **Result)
{
  int res = FALSE;
  if (icl_IsStruct(Perm) && (icl_NumTerms(Perm) == 1) &&
      icl_IsList(PermList)) {
    ICLTerm *p;

    if (icl_ParamValue(icl_Str(Perm), NULL, PermList, &p)) {
      res = icl_Unify(Perm, p, Result);
      icl_Free(p);
    } else

      if (icl_ParamValue(icl_Str(Perm), NULL, perm_default_list(), &p)) {
        res = icl_Unify(Perm, p, Result);
        icl_Free(p);
      }

    return res;
  }
  else return FALSE;
}


/* NOT IMPLEMENTED YET
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   % name:    icl_RestrictParam(+ParamList, +ParamName, +ParamValue)
   % purpose: Often used in solvable declarations to filter on a certain
   %          condition.
   % definition:
   %          Test a param list: if one or more values are given in a parameter
   %          list for parameter ParamName, then ParamValue must be defined as
   %          one of the values to succeed.  If ParamValue is NOT defined, then
   %          icl_RestrictParam succeeds.
   % example:
   %    A natural language parser agent can only handle English definitions:
   %
   %        convert(nl, icl,Input,Params,Output) :-
   %               icl_RestrictParams(Params, language, english).
   %
   %    if "language(english)" is defined in parameter list of a solve request,
   %       the nl agent will receive the request.
   %    if "language(spanish)" is defined in the parameter list, the nl agent
   %       WILL NOT receive the request.
   %    if no language parameter is specified, the request WILL be sent
   %    if "language(X)" is specified, the request WILL be sent to the nl agent
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   icl_RestrictParam(ParamList, Param, Value) :-
*/



/****************************************************************************
 * Agent identity and addressing
 *
 * Every agent (including facilitators) has a symbolic name, a full address,
 * and a local address (or "local ID").  A full address has the form:
 *     addr(tcp(Host,Port))              for a facilitator (if TCP is protocol)
 *     addr(tcp(Host,Port), LocalID)     for a client agent.
 *
 * Even though it doesn't appear in the full address, a facilitator also
 * has a local ID, for consistency and convenient reference. The
 * local ID of a client agent is assigned to it by its facilitator.
 * This, and the facilitator's local ID, are passed to the client at
 * connection time.
 *
 * Full addresses are globally unique, and local addresses are unique with
 * respect to a facilitator.  Symbolic names are NOT unique in any sense.
 *
 * The local ID happens to be an integer, but developers should not rely
 * on this.
 *
 * When specifying addresses, in address/1 params for calls to
 * oaa_AddData, oaa_Solve, etc., either names or addresses may be used.
 * In addition, for convenience, reserved terms 'self', 'parent', and
 * 'facilitator' may also be used.
 *
 * More precisely, the address parameter may contain any of the following:
 * a full address; a local ID (when the addressee is known to be either
 * the facilitator or a peer client); a name, enclosed in the name/1 functor;
 * 'self'; 'parent'; or 'facilitator'.  ('parent' and 'facilitator are
 * synonymous.)
 *
 * Address parameters are standardized as follows: A full address for the
 * local facilitator or a peer client is changed to the local ID; all
 * other full addresses are left as is.  Names are left as is.  'self',
 * 'parent', and 'facilitator' are changed to the appropriate local ID.
 *
 ***************************************************************************/

/**
 * Returns TRUE if Term is a valid address name
 * Any atom except for "parent", "self" or "facilitator" may be a name
 */
int icl_name(ICLTerm *term)
{
  if (icl_IsStr(term)) {
    char *s = icl_Str(term);

    return (!(STREQ(s,"self") ||
              STREQ(s,"parent") ||
              STREQ(s,"facilitator")));
  }
  else return FALSE;
}


/**
 * Returns canonical term for a lowest-level id.
 * f fails, doesn't change result Id.
 */
int icl_true_id(ICLTerm *term, ICLTerm **Id)
{
  int res = TRUE;

  if (icl_IsInt(term))
    *Id = icl_CopyTerm(term);
  else

    if (icl_IsStr(term)) {

      if STREQ(icl_Str(term), "self") {
        res = oaa_PrimaryAddress(Id);
      }
      else
	if (STREQ(icl_Str(term), "parent") ||
	    STREQ(icl_Str(term), "facilitator")) {
	  ICLTerm *fid, *t1;

	  res = com_GetInfo("parent",
			    (t1 = icl_NewStruct("fac_id",
						1,
						icl_NewVar("FId"))),
			    &fid);

	  icl_Free(t1);
	  if (res) {
	    *Id = icl_CopyTerm(icl_NthTerm(fid, 1));
	    icl_Free(fid);
	  }
	}
	else res = FALSE;
    }
    else res = FALSE;

  return res;
}


/**
 * Standardizes an addressee.
 * Can only be used after oaa_Register() because of the reliance on
 * com_GetInfo().
 */
int
icl_standardize_addressee(ICLTerm *Addr, ICLTerm **StandardAddr)
{
  ICLTerm *tempRequest = icl_NewTermFromData("other_address(A)",16);
  ICLTerm *result = NULL;
  ICLTerm *fid = NULL;
  ICLTerm *t1;
  int freeResult = FALSE;
  int	   returnValue = 0;

  /* -- self */
  if (icl_IsStr(Addr) && (STREQ(icl_Str(Addr),"self"))) {
    oaa_PrimaryAddress(&result);
    // need to icl_Free() result below...
    freeResult = TRUE;
  }else
    /* -- parent */
    if (icl_IsStr(Addr) && (STREQ(icl_Str(Addr),"parent"))) {
      com_GetInfo("parent", tempRequest, &fid);
      if (fid != NULL) {
        result = icl_CopyTerm(icl_NthTerm(fid, 1));
        // need to icl_Free() result below...
        freeResult = TRUE;
        icl_Free(fid);
      }
    }else

      /* -- facilitator */
      if (icl_IsStr(Addr) && (STREQ(icl_Str(Addr),"facilitator"))) {
        com_GetInfo("parent", tempRequest, &fid);
        if (fid != NULL) {
          result = icl_CopyTerm(icl_NthTerm(fid, 1));
          // need to icl_Free() result below...
          freeResult = TRUE;
          icl_Free(fid);
        }
      }else

        /* -- tcp(A,B) */
        if (icl_IsStruct(Addr) &&  (STREQ(icl_Str(Addr),"tcp")) &&
            (icl_NumTerms(Addr)==2)) {
          result = Addr;
          // don't free result below...
          freeResult = FALSE;
        }else