自学教程：C++ EnvArgTypeCheck函数代码示例

/******************************************************  NAME         : CheckTwoClasses  DESCRIPTION  : Checks for exactly two class arguments                    for a H/L function  INPUTS       : 1) The function name                 2) Caller's buffer for first class                 3) Caller's buffer for second class  RETURNS      : TRUE if both found, FALSE otherwise  SIDE EFFECTS : Caller's buffers set  NOTES        : Assumes exactly 2 arguments ******************************************************/static int CheckTwoClasses(  void *theEnv,  char *func,  DEFCLASS **c1,  DEFCLASS **c2)  {   DATA_OBJECT temp;   if (EnvArgTypeCheck(theEnv,func,1,SYMBOL,&temp) == FALSE)     return(FALSE);   *c1 = LookupDefclassByMdlOrScope(theEnv,DOToString(temp));   if (*c1 == NULL)     {      ClassExistError(theEnv,func,ValueToString(temp.value));      return(FALSE);     }   if (EnvArgTypeCheck(theEnv,func,2,SYMBOL,&temp) == FALSE)     return(FALSE);   *c2 = LookupDefclassByMdlOrScope(theEnv,DOToString(temp));   if (*c2 == NULL)     {      ClassExistError(theEnv,func,ValueToString(temp.value));      return(FALSE);     }   return(TRUE);  }

/************************************************************************************  NAME         : MessageHandlerExistPCommand  DESCRIPTION  : Determines if a message-handler is present in a class  INPUTS       : None  RETURNS      : TRUE if the message header is present, FALSE otherwise  SIDE EFFECTS : None  NOTES        : H/L Syntax : (message-handler-existp <class> <hnd> [<type>]) ************************************************************************************/globle int MessageHandlerExistPCommand(  void *theEnv)  {   DEFCLASS *cls;   SYMBOL_HN *mname;   DATA_OBJECT temp;   unsigned mtype = MPRIMARY;      if (EnvArgTypeCheck(theEnv,"message-handler-existp",1,SYMBOL,&temp) == FALSE)     return(FALSE);   cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp));   if (cls == NULL)     {      ClassExistError(theEnv,"message-handler-existp",DOToString(temp));      return(FALSE);     }   if (EnvArgTypeCheck(theEnv,"message-handler-existp",2,SYMBOL,&temp) == FALSE)     return(FALSE);   mname = (SYMBOL_HN *) GetValue(temp);   if (EnvRtnArgCount(theEnv) == 3)     {      if (EnvArgTypeCheck(theEnv,"message-handler-existp",3,SYMBOL,&temp) == FALSE)        return(FALSE);      mtype = HandlerType(theEnv,"message-handler-existp",DOToString(temp));      if (mtype == MERROR)        {         SetEvaluationError(theEnv,TRUE);         return(FALSE);        }     }   if (FindHandlerByAddress(cls,mname,mtype) != NULL)     return(TRUE);   return(FALSE);  }

globle void ModFunction(  void *theEnv,  DATA_OBJECT_PTR result)  {   DATA_OBJECT item1, item2;   double fnum1, fnum2;   long long lnum1, lnum2;   if (EnvArgCountCheck(theEnv,"mod",EXACTLY,2) == -1)     {      result->type = INTEGER;      result->value = (void *) EnvAddLong(theEnv,0L);      return;     }   if (EnvArgTypeCheck(theEnv,"mod",1,INTEGER_OR_FLOAT,&item1) == FALSE)     {      result->type = INTEGER;      result->value = (void *) EnvAddLong(theEnv,0L);      return;     }   if (EnvArgTypeCheck(theEnv,"mod",2,INTEGER_OR_FLOAT,&item2) == FALSE)     {      result->type = INTEGER;      result->value = (void *) EnvAddLong(theEnv,0L);      return;     }   if (((item2.type == INTEGER) ? (ValueToLong(item2.value) == 0L) : FALSE) ||       ((item2.type == FLOAT) ? ValueToDouble(item2.value) == 0.0 : FALSE))     {      DivideByZeroErrorMessage(theEnv,"mod");      SetEvaluationError(theEnv,TRUE);      result->type = INTEGER;      result->value = (void *) EnvAddLong(theEnv,0L);      return;     }   if ((item1.type == FLOAT) || (item2.type == FLOAT))     {      fnum1 = CoerceToDouble(item1.type,item1.value);      fnum2 = CoerceToDouble(item2.type,item2.value);      result->type = FLOAT;      result->value = (void *) EnvAddDouble(theEnv,fnum1 - (dtrunc(fnum1 / fnum2) * fnum2));     }   else     {      lnum1 = DOToLong(item1);      lnum2 = DOToLong(item2);      result->type = INTEGER;      result->value = (void *) EnvAddLong(theEnv,lnum1 - (lnum1 / lnum2) * lnum2);     }  }

globle void StrIndexFunction(  void *theEnv,  DATA_OBJECT_PTR result)  {   DATA_OBJECT theArgument1, theArgument2;   char *strg1, *strg2;   int i, j;   result->type = SYMBOL;   result->value = EnvFalseSymbol(theEnv);   /*===================================*/   /* Check and retrieve the arguments. */   /*===================================*/   if (EnvArgCountCheck(theEnv,"str-index",EXACTLY,2) == -1) return;   if (EnvArgTypeCheck(theEnv,"str-index",1,SYMBOL_OR_STRING,&theArgument1) == FALSE) return;   if (EnvArgTypeCheck(theEnv,"str-index",2,SYMBOL_OR_STRING,&theArgument2) == FALSE) return;   strg1 = DOToString(theArgument1);   strg2 = DOToString(theArgument2);   /*=================================*/   /* Find the position in string2 of */   /* string1 (counting from 1).      */   /*=================================*/   if (strlen(strg1) == 0)     {      result->type = INTEGER;      result->value = (void *) EnvAddLong(theEnv,(long) strlen(strg2) + 1L);      return;     }   for (i=1; *strg2; i++, strg2++)     {      for (j=0; *(strg1+j) && *(strg1+j) == *(strg2+j); j++)        { /* Do Nothing */ }      if (*(strg1+j) == '/0')        {         result->type = INTEGER;         result->value = (void *) EnvAddLong(theEnv,(long) i);         return;        }     }   return;  }

globle long int StrCompareFunction(  void *theEnv)  {   int numArgs, length;   DATA_OBJECT arg1, arg2, arg3;   long returnValue;   /*=======================================================*/   /* Function str-compare expects either 2 or 3 arguments. */   /*=======================================================*/   if ((numArgs = EnvArgRangeCheck(theEnv,"str-compare",2,3)) == -1) return(0L);   /*=============================================================*/   /* The first two arguments should be of type symbol or string. */   /*=============================================================*/   if (EnvArgTypeCheck(theEnv,"str-compare",1,SYMBOL_OR_STRING,&arg1) == FALSE)     { return(0L); }   if (EnvArgTypeCheck(theEnv,"str-compare",2,SYMBOL_OR_STRING,&arg2) == FALSE)     { return(0L); }   /*===================================================*/   /* Compare the strings. Use the 3rd argument for the */   /* maximum length of comparison, if it is provided.  */   /*===================================================*/   if (numArgs == 3)     {      if (EnvArgTypeCheck(theEnv,"str-compare",3,INTEGER,&arg3) == FALSE)        { return(0L); }      length = CoerceToInteger(GetType(arg3),GetValue(arg3));      returnValue = strncmp(DOToString(arg1),DOToString(arg2),                            (STD_SIZE) length);     }   else     { returnValue = strcmp(DOToString(arg1),DOToString(arg2)); }   /*========================================================*/   /* Return Values are as follows:                          */   /* -1 is returned if <string-1> is less than <string-2>.  */   /*  1 is return if <string-1> is greater than <string-2>. */   /*  0 is returned if <string-1> is equal to <string-2>.   */   /*========================================================*/   if (returnValue < 0) returnValue = -1;   else if (returnValue > 0) returnValue = 1;   return(returnValue);  }

/*******************************************************************************  NAME         : PPDefmessageHandlerCommand  DESCRIPTION  : Displays the pretty-print form (if any) for a handler  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : None  NOTES        : H/L Syntax: (ppdefmessage-handler <class> <message> [<type>]) *******************************************************************************/globle void PPDefmessageHandlerCommand(  void *theEnv)  {   DATA_OBJECT temp;   SYMBOL_HN *csym,*msym;   const char *tname;   DEFCLASS *cls = NULL;   unsigned mtype;   HANDLER *hnd;   if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",1,SYMBOL,&temp) == FALSE)     return;   csym = FindSymbolHN(theEnv,DOToString(temp));   if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",2,SYMBOL,&temp) == FALSE)     return;   msym = FindSymbolHN(theEnv,DOToString(temp));   if (EnvRtnArgCount(theEnv) == 3)     {      if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",3,SYMBOL,&temp) == FALSE)        return;      tname = DOToString(temp);     }   else     tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY];   mtype = HandlerType(theEnv,"ppdefmessage-handler",tname);   if (mtype == MERROR)     {      EnvSetEvaluationError(theEnv,TRUE);      return;     }   if (csym != NULL)     cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(csym));   if (((cls == NULL) || (msym == NULL)) ? TRUE :       ((hnd = FindHandlerByAddress(cls,msym,(unsigned) mtype)) == NULL))     {      PrintErrorID(theEnv,"MSGCOM",2,FALSE);      EnvPrintRouter(theEnv,WERROR,"Unable to find message-handler ");      EnvPrintRouter(theEnv,WERROR,ValueToString(msym));      EnvPrintRouter(theEnv,WERROR," ");      EnvPrintRouter(theEnv,WERROR,tname);      EnvPrintRouter(theEnv,WERROR," for class ");      EnvPrintRouter(theEnv,WERROR,ValueToString(csym));      EnvPrintRouter(theEnv,WERROR," in function ppdefmessage-handler./n");      EnvSetEvaluationError(theEnv,TRUE);      return;     }   if (hnd->ppForm != NULL)     PrintInChunks(theEnv,WDISPLAY,hnd->ppForm);  }

globle long int SetgenFunction(    void *theEnv){    long theLong;    DATA_OBJECT theValue;    /*==========================================================*/    /* Check to see that a single integer argument is provided. */    /*==========================================================*/    if (EnvArgCountCheck(theEnv,"setgen",EXACTLY,1) == -1) return(MiscFunctionData(theEnv)->GensymNumber);    if (EnvArgTypeCheck(theEnv,"setgen",1,INTEGER,&theValue) == FALSE) return(MiscFunctionData(theEnv)->GensymNumber);    /*========================================*/    /* The integer must be greater than zero. */    /*========================================*/    theLong = ValueToLong(theValue.value);    if (theLong < 1L)    {        ExpectedTypeError1(theEnv,"setgen",1,"number (greater than or equal to 1)");        return(MiscFunctionData(theEnv)->GensymNumber);    }    /*====================================*/    /* Set the gensym index to the number */    /* provided and return this value.    */    /*====================================*/    MiscFunctionData(theEnv)->GensymNumber = theLong;    return(theLong);}

globle double FloatFunction(  void *theEnv)  {   DATA_OBJECT valstruct;   /*============================================*/   /* Check for the correct number of arguments. */   /*============================================*/   if (EnvArgCountCheck(theEnv,"float",EXACTLY,1) == -1) return(0.0);   /*================================================================*/   /* Check for the correct type of argument. Note that ArgTypeCheck */   /* will convert integers to floats when a float is requested      */   /* (which is the purpose of the float function).                  */   /*================================================================*/   if (EnvArgTypeCheck(theEnv,"float",1,FLOAT,&valstruct) == FALSE) return(0.0);   /*================================================*/   /* Return the numeric value converted to a float. */   /*================================================*/   return(ValueToDouble(valstruct.value));  }

globle long int IntegerFunction(  void *theEnv)  {   DATA_OBJECT valstruct;   /*============================================*/   /* Check for the correct number of arguments. */   /*============================================*/   if (EnvArgCountCheck(theEnv,"integer",EXACTLY,1) == -1) return(0L);   /*================================================================*/   /* Check for the correct type of argument. Note that ArgTypeCheck */   /* will convert floats to integers when an integer is requested   */   /* (which is the purpose of the integer function).                */   /*================================================================*/   if (EnvArgTypeCheck(theEnv,"integer",1,INTEGER,&valstruct) == FALSE) return(0L);   /*===================================================*/   /* Return the numeric value converted to an integer. */   /*===================================================*/   return(ValueToLong(valstruct.value));  }

/****************************************************************  NAME         : BrowseClassesCommand  DESCRIPTION  : Displays a "graph" of the class hierarchy  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : None  NOTES        : Syntax : (browse-classes [<class>]) ****************************************************************/globle void BrowseClassesCommand(  void *theEnv)  {   register DEFCLASS *cls;      if (EnvRtnArgCount(theEnv) == 0)      /* ================================================         Find the OBJECT root class (has no superclasses)         ================================================ */      cls = LookupDefclassByMdlOrScope(theEnv,OBJECT_TYPE_NAME);   else     {      DATA_OBJECT tmp;      if (EnvArgTypeCheck(theEnv,"browse-classes",1,SYMBOL,&tmp) == FALSE)        return;      cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp));      if (cls == NULL)        {         ClassExistError(theEnv,"browse-classes",DOToString(tmp));         return;        }     }   EnvBrowseClasses(theEnv,WDISPLAY,(void *) cls);  }

globle void EvalFunction(  void *theEnv,  DATA_OBJECT_PTR returnValue)  {   DATA_OBJECT theArg;   /*=============================================*/   /* Function eval expects exactly one argument. */   /*=============================================*/   if (EnvArgCountCheck(theEnv,"eval",EXACTLY,1) == -1)     {      SetpType(returnValue,SYMBOL);      SetpValue(returnValue,EnvFalseSymbol(theEnv));      return;     }   /*==================================================*/   /* The argument should be of type SYMBOL or STRING. */   /*==================================================*/   if (EnvArgTypeCheck(theEnv,"eval",1,SYMBOL_OR_STRING,&theArg) == FALSE)     {      SetpType(returnValue,SYMBOL);      SetpValue(returnValue,EnvFalseSymbol(theEnv));      return;     }   /*======================*/   /* Evaluate the string. */   /*======================*/   EnvEval(theEnv,DOToString(theArg),returnValue);  }

globle void StringToFieldFunction(  void *theEnv,  DATA_OBJECT *returnValue)  {   DATA_OBJECT theArg;   /*========================================================*/   /* Function string-to-field expects exactly one argument. */   /*========================================================*/   if (EnvArgCountCheck(theEnv,"string-to-field",EXACTLY,1) == -1)     {      returnValue->type = STRING;      returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***");      return;     }   /*==================================================*/   /* The argument should be of type symbol or string. */   /*==================================================*/   if (EnvArgTypeCheck(theEnv,"string-to-field",1,SYMBOL_OR_STRING,&theArg) == FALSE)     {      returnValue->type = STRING;      returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***");      return;     }   /*================================*/   /* Convert the string to an atom. */   /*================================*/   StringToField(theEnv,DOToString(theArg),returnValue);  }

globle long int StrLengthFunction(  void *theEnv)  {   DATA_OBJECT theArg;   /*===================================================*/   /* Function str-length expects exactly one argument. */   /*===================================================*/   if (EnvArgCountCheck(theEnv,"str-length",EXACTLY,1) == -1)     { return(-1L); }   /*==================================================*/   /* The argument should be of type symbol or string. */   /*==================================================*/   if (EnvArgTypeCheck(theEnv,"str-length",1,SYMBOL_OR_STRING,&theArg) == FALSE)     { return(-1L); }   /*============================================*/   /* Return the length of the string or symbol. */   /*============================================*/   return( (long) strlen(DOToString(theArg)));  }

globle void RemoveBreakCommand(  void *theEnv)  {   DATA_OBJECT argPtr;   char *argument;   int nargs;   void *defrulePtr;   if ((nargs = EnvArgCountCheck(theEnv,"remove-break",NO_MORE_THAN,1)) == -1)     { return; }   if (nargs == 0)     {      RemoveAllBreakpoints(theEnv);      return;     }   if (EnvArgTypeCheck(theEnv,"remove-break",1,SYMBOL,&argPtr) == FALSE) return;   argument = DOToString(argPtr);   if ((defrulePtr = EnvFindDefrule(theEnv,argument)) == NULL)     {      CantFindItemErrorMessage(theEnv,"defrule",argument);      return;     }   if (EnvRemoveBreak(theEnv,defrulePtr) == FALSE)     {      EnvPrintRouter(theEnv,WERROR,"Rule ");      EnvPrintRouter(theEnv,WERROR,argument);      EnvPrintRouter(theEnv,WERROR," does not have a breakpoint set./n");     }  }

globle void AproposCommand(    void *theEnv){    char *argument;    DATA_OBJECT argPtr;    struct symbolHashNode *hashPtr = NULL;    size_t theLength;    /*=======================================================*/    /* The apropos command expects a single symbol argument. */    /*=======================================================*/    if (EnvArgCountCheck(theEnv,"apropos",EXACTLY,1) == -1) return;    if (EnvArgTypeCheck(theEnv,"apropos",1,SYMBOL,&argPtr) == FALSE) return;    /*=======================================*/    /* Determine the length of the argument. */    /*=======================================*/    argument = DOToString(argPtr);    theLength = strlen(argument);    /*====================================================================*/    /* Print each entry in the symbol table that contains the argument as */    /* a substring. When using a non-ANSI compiler, only those strings    */    /* that contain the substring starting at the beginning of the string */    /* are printed.                                                       */    /*====================================================================*/    while ((hashPtr = GetNextSymbolMatch(theEnv,argument,theLength,hashPtr,TRUE,NULL)) != NULL)    {        EnvPrintRouter(theEnv,WDISPLAY,ValueToString(hashPtr));        EnvPrintRouter(theEnv,WDISPLAY,"/n");    }}

  void get_argument(void* env, int argposition, Values& values) {    DATA_OBJECT arg;    if (EnvArgTypeCheck(env, (char *)"clipsmm get_argument",                        argposition, MULTIFIELD, &arg) == 0)   return;    values.clear();    int end = EnvGetDOEnd(env, arg);    void *mfp = EnvGetValue(env, arg);    for (int i = EnvGetDOBegin(env, arg); i <= end; ++i) {      switch (GetMFType(mfp, i)) {      case SYMBOL:      case STRING:      case INSTANCE_NAME:        values.push_back(Value(ValueToString(GetMFValue(mfp, i))));        break;      case FLOAT:        values.push_back(Value(ValueToDouble(GetMFValue(mfp, i))));        break;      case INTEGER:        values.push_back(Value(ValueToInteger(GetMFValue(mfp, i))));        break;      default:        continue;        break;      }    }  }

/**********************************************************************  NAME         : CheckMultifieldSlotInstance  DESCRIPTION  : Gets the instance for the functions slot-replace$,                    insert and delete  INPUTS       : The function name  RETURNS      : The instance address, NULL on errors  SIDE EFFECTS : None  NOTES        : None **********************************************************************/static INSTANCE_TYPE *CheckMultifieldSlotInstance(  void *theEnv,  char *func)  {   INSTANCE_TYPE *ins;   DATA_OBJECT temp;   if (EnvArgTypeCheck(theEnv,func,1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE)     {      SetEvaluationError(theEnv,TRUE);      return(NULL);     }   if (temp.type == INSTANCE_ADDRESS)     {      ins = (INSTANCE_TYPE *) temp.value;      if (ins->garbage == 1)        {         StaleInstanceAddress(theEnv,func,0);         SetEvaluationError(theEnv,TRUE);         return(NULL);        }     }   else     {      ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);      if (ins == NULL)        NoInstanceError(theEnv,ValueToString(temp.value),func);     }   return(ins);  }

globle double SetProfilePercentThresholdCommand(  void *theEnv)  {   DATA_OBJECT theValue;   double newThreshold;      if (EnvArgCountCheck(theEnv,"set-profile-percent-threshold",EXACTLY,1) == -1)     { return(ProfileFunctionData(theEnv)->PercentThreshold); }   if (EnvArgTypeCheck(theEnv,"set-profile-percent-threshold",1,INTEGER_OR_FLOAT,&theValue) == FALSE)      { return(ProfileFunctionData(theEnv)->PercentThreshold); }   if (GetType(theValue) == INTEGER)     { newThreshold = (double) DOToLong(theValue); }   else     { newThreshold = (double) DOToDouble(theValue); }        if ((newThreshold < 0.0) || (newThreshold > 100.0))     {       ExpectedTypeError1(theEnv,"set-profile-percent-threshold",1,                         "number in the range 0 to 100");      return(-1.0);      }   return(SetProfilePercentThreshold(theEnv,newThreshold));  }

/*********************************************************************  NAME         : SlotExistPCommand  DESCRIPTION  : Determines if a slot is present in a class  INPUTS       : None  RETURNS      : TRUE if the slot exists, FALSE otherwise  SIDE EFFECTS : None  NOTES        : H/L Syntax : (slot-existp <class> <slot> [inherit]) *********************************************************************/globle int SlotExistPCommand(  void *theEnv)  {   DEFCLASS *cls;   SLOT_DESC *sd;   int inheritFlag = FALSE;   DATA_OBJECT dobj;      sd = CheckSlotExists(theEnv,"slot-existp",&cls,FALSE,TRUE);   if (sd == NULL)     return(FALSE);   if (EnvRtnArgCount(theEnv) == 3)     {      if (EnvArgTypeCheck(theEnv,"slot-existp",3,SYMBOL,&dobj) == FALSE)        return(FALSE);      if (strcmp(DOToString(dobj),"inherit") != 0)        {         ExpectedTypeError1(theEnv,"slot-existp",3,"keyword /"inherit/"");         SetEvaluationError(theEnv,TRUE);         return(FALSE);        }      inheritFlag = TRUE;     }   return((sd->cls == cls) ? TRUE : inheritFlag);  }

globle void CheckSyntaxFunction(  void *theEnv,  DATA_OBJECT *returnValue)  {   DATA_OBJECT theArg;   /*===============================*/   /* Set up a default return value */   /* (TRUE for problems found).    */   /*===============================*/   SetpType(returnValue,SYMBOL);   SetpValue(returnValue,EnvTrueSymbol(theEnv));   /*=====================================================*/   /* Function check-syntax expects exactly one argument. */   /*=====================================================*/   if (EnvArgCountCheck(theEnv,"check-syntax",EXACTLY,1) == -1) return;   /*========================================*/   /* The argument should be of type STRING. */   /*========================================*/   if (EnvArgTypeCheck(theEnv,"check-syntax",1,STRING,&theArg) == FALSE)     { return; }   /*===================*/   /* Check the syntax. */   /*===================*/   CheckSyntax(theEnv,DOToString(theArg),returnValue);  }

globle void *SetSalienceEvaluationCommand(    void *theEnv){    DATA_OBJECT argPtr;    char *argument, *oldValue;    /*==================================================*/    /* Get the current setting for salience evaluation. */    /*==================================================*/    oldValue = SalienceEvaluationName(EnvGetSalienceEvaluation(theEnv));    /*=========================================*/    /* This function expects a single argument */    /* which must be a symbol.                 */    /*=========================================*/    if (EnvArgCountCheck(theEnv,(char*)"set-salience-evaluation",EXACTLY,1) == -1)    {        return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));    }    if (EnvArgTypeCheck(theEnv,(char*)"set-salience-evaluation",1,SYMBOL,&argPtr) == FALSE)    {        return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));    }    /*=============================================================*/    /* The allowed symbols to pass as an argument to this function */    /* are when-defined, when-activated, and every-cycle.          */    /*=============================================================*/    argument = DOToString(argPtr);    if (strcmp(argument,(char*)"when-defined") == 0)    {        EnvSetSalienceEvaluation(theEnv,WHEN_DEFINED);    }    else if (strcmp(argument,(char*)"when-activated") == 0)    {        EnvSetSalienceEvaluation(theEnv,WHEN_ACTIVATED);    }    else if (strcmp(argument,(char*)"every-cycle") == 0)    {        EnvSetSalienceEvaluation(theEnv,EVERY_CYCLE);    }    else    {        ExpectedTypeError1(theEnv,(char*)"set-salience-evaluation",1,                           (char*)"symbol with value when-defined, when-activated, or every-cycle");        return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));    }    /*=================================================*/    /* Return the old setting for salience evaluation. */    /*=================================================*/    return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));}

globle long RandomFunction(    void *theEnv){    int argCount;    long rv;    DATA_OBJECT theValue;    long begin, end;    /*====================================*/    /* The random function accepts either */    /* zero or two arguments.             */    /*====================================*/    argCount = EnvRtnArgCount(theEnv);    if ((argCount != 0) && (argCount != 2))    {        PrintErrorID(theEnv,"MISCFUN",2,FALSE);        EnvPrintRouter(theEnv,WERROR,"Function random expected either 0 or 2 arguments/n");    }    /*========================================*/    /* Return the randomly generated integer. */    /*========================================*/    rv = genrand();    if (argCount == 2)    {        if (EnvArgTypeCheck(theEnv,"random",1,INTEGER,&theValue) == FALSE) return(rv);        begin = DOToLong(theValue);        if (EnvArgTypeCheck(theEnv,"random",2,INTEGER,&theValue) == FALSE) return(rv);        end = DOToLong(theValue);        if (end < begin)        {            PrintErrorID(theEnv,"MISCFUN",3,FALSE);            EnvPrintRouter(theEnv,WERROR,"Function random expected argument #1 to be less than argument #2/n");            return(rv);        }        rv = begin + (rv % ((end - begin) + 1));    }    return(rv);}

globle void LowcaseFunction(  void *theEnv,  DATA_OBJECT_PTR returnValue)  {   DATA_OBJECT theArg;   unsigned i;   size_t slen;   char *osptr, *nsptr;   /*================================================*/   /* Function lowcase expects exactly one argument. */   /*================================================*/   if (EnvArgCountCheck(theEnv,"lowcase",EXACTLY,1) == -1)     {      SetpType(returnValue,STRING);      SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));      return;     }   /*==================================================*/   /* The argument should be of type symbol or string. */   /*==================================================*/   if (EnvArgTypeCheck(theEnv,"lowcase",1,SYMBOL_OR_STRING,&theArg) == FALSE)     {      SetpType(returnValue,STRING);      SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));      return;     }   /*======================================================*/   /* Allocate temporary memory and then copy the original */   /* string or symbol to that memory, while lowercasing   */   /* upper case alphabetic characters.                    */   /*======================================================*/   osptr = DOToString(theArg);   slen = strlen(osptr) + 1;   nsptr = (char *) gm2(theEnv,slen);   for (i = 0  ; i < slen ; i++)     {      if (isupper(osptr[i]))        { nsptr[i] = (char) tolower(osptr[i]); }      else        { nsptr[i] = osptr[i]; }     }   /*========================================*/   /* Return the lowercased string and clean */   /* up the temporary memory used.          */   /*========================================*/   SetpType(returnValue,GetType(theArg));   SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,nsptr));   rm(theEnv,nsptr,slen);  }

/********************************************************  NAME         : ClassExistPCommand  DESCRIPTION  : Determines if a class exists  INPUTS       : None  RETURNS      : TRUE if class exists, FALSE otherwise  SIDE EFFECTS : None  NOTES        : H/L Syntax : (class-existp <arg>) ********************************************************/globle intBool ClassExistPCommand(  void *theEnv)  {   DATA_OBJECT temp;      if (EnvArgTypeCheck(theEnv,"class-existp",1,SYMBOL,&temp) == FALSE)     return(FALSE);   return((LookupDefclassByMdlOrScope(theEnv,DOToString(temp)) != NULL) ? TRUE : FALSE);  }

/******************************************************************************  NAME         : UndefmessageHandlerCommand  DESCRIPTION  : Deletes a handler from a class  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : Handler deleted if possible  NOTES        : H/L Syntax: (undefmessage-handler <class> <handler> [<type>]) ******************************************************************************/globle void UndefmessageHandlerCommand(  void *theEnv)  {#if RUN_TIME || BLOAD_ONLY   PrintErrorID(theEnv,"MSGCOM",3,FALSE);   EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers./n");#else   SYMBOL_HN *mname;   const char *tname;   DATA_OBJECT tmp;   DEFCLASS *cls;#if BLOAD || BLOAD_AND_BSAVE   if (Bloaded(theEnv))     {      PrintErrorID(theEnv,"MSGCOM",3,FALSE);      EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers./n");      return;     }#endif   if (EnvArgTypeCheck(theEnv,"undefmessage-handler",1,SYMBOL,&tmp) == FALSE)     return;   cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp));   if ((cls == NULL) ? (strcmp(DOToString(tmp),"*") != 0) : FALSE)     {      ClassExistError(theEnv,"undefmessage-handler",DOToString(tmp));      return;     }   if (EnvArgTypeCheck(theEnv,"undefmessage-handler",2,SYMBOL,&tmp) == FALSE)     return;   mname = (SYMBOL_HN *) tmp.value;   if (EnvRtnArgCount(theEnv) == 3)     {      if (EnvArgTypeCheck(theEnv,"undefmessage-handler",3,SYMBOL,&tmp) == FALSE)        return;      tname = DOToString(tmp);      if (strcmp(tname,"*") == 0)        tname = NULL;     }   else     tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY];   WildDeleteHandler(theEnv,cls,mname,tname);#endif  }

/*********************************************************  NAME         : GetClassNameArgument  DESCRIPTION  : Gets a class name-string  INPUTS       : Calling function name  RETURNS      : Class name (NULL on errors)  SIDE EFFECTS : None  NOTES        : Assumes only 1 argument *********************************************************/static char *GetClassNameArgument(  void *theEnv,  char *fname)  {   DATA_OBJECT temp;   if (EnvArgTypeCheck(theEnv,fname,1,SYMBOL,&temp) == FALSE)     return(NULL);   return(DOToString(temp));  }

/********************************************************************  NAME         : CheckClassAndSlot  DESCRIPTION  : Checks class and slot argument for various functions  INPUTS       : 1) Name of the calling function                 2) Buffer for class address  RETURNS      : Slot symbol, NULL on errors  SIDE EFFECTS : None  NOTES        : None ********************************************************************/globle SYMBOL_HN *CheckClassAndSlot(   void *theEnv,   const char *func,   DEFCLASS **cls)  {   DATA_OBJECT temp;   if (EnvArgTypeCheck(theEnv,func,1,SYMBOL,&temp) == FALSE)     return(NULL);   *cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp));   if (*cls == NULL)     {      ClassExistError(theEnv,func,DOToString(temp));      return(NULL);     }   if (EnvArgTypeCheck(theEnv,func,2,SYMBOL,&temp) == FALSE)     return(NULL);   return((SYMBOL_HN *) GetValue(temp));  }

globle void *SetStrategyCommand(  void *theEnv)  {   DATA_OBJECT argPtr;   char *argument;   int oldStrategy;   oldStrategy = AgendaData(theEnv)->Strategy;   /*=====================================================*/   /* Check for the correct number and type of arguments. */   /*=====================================================*/   if (EnvArgCountCheck(theEnv,"set-strategy",EXACTLY,1) == -1)     { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); }   if (EnvArgTypeCheck(theEnv,"set-strategy",1,SYMBOL,&argPtr) == FALSE)     { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); }   argument = DOToString(argPtr);   /*=============================================*/   /* Set the strategy to the specified strategy. */   /*=============================================*/   if (strcmp(argument,"depth") == 0)     { EnvSetStrategy(theEnv,DEPTH_STRATEGY); }   else if (strcmp(argument,"breadth") == 0)     { EnvSetStrategy(theEnv,BREADTH_STRATEGY); }   else if (strcmp(argument,"lex") == 0)     { EnvSetStrategy(theEnv,LEX_STRATEGY); }   else if (strcmp(argument,"mea") == 0)     { EnvSetStrategy(theEnv,MEA_STRATEGY); }   else if (strcmp(argument,"complexity") == 0)     { EnvSetStrategy(theEnv,COMPLEXITY_STRATEGY); }   else if (strcmp(argument,"simplicity") == 0)     { EnvSetStrategy(theEnv,SIMPLICITY_STRATEGY); }   else if (strcmp(argument,"random") == 0)     { EnvSetStrategy(theEnv,RANDOM_STRATEGY); }   else     {      ExpectedTypeError1(theEnv,"set-strategy",1,      "symbol with value depth, breadth, lex, mea, complexity, simplicity, or random");      return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv))));     }   /*=======================================*/   /* Return the old value of the strategy. */   /*=======================================*/   return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(oldStrategy)));  }

/********************************************************************  NAME         : PreviewSendCommand  DESCRIPTION  : Displays a list of the core for a message describing                   shadows,etc.  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : Temporary core created and destroyed  NOTES        : H/L Syntax: (preview-send <class> <msg>) ********************************************************************/globle void PreviewSendCommand(  void *theEnv)  {   DEFCLASS *cls;   DATA_OBJECT temp;   /* =============================      Get the class for the message      ============================= */   if (EnvArgTypeCheck(theEnv,"preview-send",1,SYMBOL,&temp) == FALSE)     return;   cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp));   if (cls == NULL)     {      ClassExistError(theEnv,"preview-send",ValueToString(temp.value));      return;     }   if (EnvArgTypeCheck(theEnv,"preview-send",2,SYMBOL,&temp) == FALSE)     return;   EnvPreviewSend(theEnv,WDISPLAY,(void *) cls,DOToString(temp));  }

static int SingleNumberCheck(  void *theEnv,  const char *functionName,  double *theNumber)  {   DATA_OBJECT theValue;   if (EnvArgCountCheck(theEnv,functionName,EXACTLY,1) == -1) return(FALSE);   if (EnvArgTypeCheck(theEnv,functionName,1,FLOAT,&theValue) == FALSE) return(FALSE);   *theNumber = DOToDouble(theValue);   return(TRUE);  }