miscfun.c

NASA 开发使用的一个专家系统

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.05  04/09/97            */
   /*                                                     */
   /*            MISCELLANEOUS FUNCTIONS MODULE           */
   /*******************************************************/

/*************************************************************/
/* Purpose:                                                  */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/

#define _MISCFUN_SOURCE_

#include <stdio.h>
#define _CLIPS_STDIO_
#include <string.h>

#include "setup.h"

#include "clipsmem.h"
#include "sysdep.h"
#include "multifld.h"
#include "exprnpsr.h"
#include "argacces.h"
#include "router.h"
#include "utility.h"

#if DEFFUNCTION_CONSTRUCT
#include "dffnxfun.h"
#endif

#include "miscfun.h"

/***************************************/
/* LOCAL INTERNAL FUNCTION DEFINITIONS */
/***************************************/

#if ANSI_COMPILER
   static VOID                    ExpandFuncMultifield(DATA_OBJECT *,EXPRESSION *,
                                                       EXPRESSION **,VOID *);
#else
   static VOID                    ExpandFuncMultifield();
#endif

/***************************************/
/* LOCAL INTERNAL VARIABLE DEFINITIONS */
/***************************************/

   static long int         GensymNumber = 1;

#if ! RUN_TIME
/*****************************************************************/
/* MiscFunctionDefinitions: Initializes miscellaneous functions. */
/*****************************************************************/
globle VOID MiscFunctionDefinitions()
  {
   DefineFunction2("gensym",           'w', PTIF GensymFunction,      "GensymFunction", "00");
   DefineFunction2("gensym*",          'w', PTIF GensymStarFunction,  "GensymStarFunction", "00");
   DefineFunction2("setgen",           'l', PTIF SetgenFunction,      "SetgenFunction", "11i");
   DefineFunction2("system",           'v', PTIF gensystem,           "gensystem", "1*k");
   DefineFunction2("length",           'l', PTIF LengthFunction,      "LengthFunction", "11q");
   DefineFunction2("length$",          'l', PTIF LengthFunction,      "LengthFunction", "11q");
   DefineFunction2("time",             'd', PTIF gentime,             "gentime", "00");
   DefineFunction2("random",           'l', PTIF RandomFunction,      "RandomFunction", "00");
   DefineFunction2("seed",             'v', PTIF SeedFunction,        "SeedFunction", "11i");
   DefineFunction2("conserve-mem",     'v', PTIF ConserveMemCommand,  "ConserveMemCommand", "11w");
   DefineFunction2("release-mem",      'l', PTIF ReleaseMemCommand,   "ReleaseMemCommand", "00");
#if DEBUGGING_FUNCTIONS
   DefineFunction2("mem-used",         'l', PTIF MemUsedCommand,      "MemUsedCommand", "00");
   DefineFunction2("mem-requests",     'l', PTIF MemRequestsCommand,  "MemRequestsCommand", "00");
#endif
   DefineFunction2("options",          'v', PTIF OptionsCommand,      "OptionsCommand", "00");
   DefineFunction2("(expansion-call)", 'u', PTIF ExpandFuncCall,      "ExpandFuncCall",NULL);
   DefineFunction2("expand$",'u', PTIF DummyExpandFuncMultifield,
                                           "DummyExpandFuncMultifield","11m");
   FuncSeqOvlFlags("expand$",CLIPS_FALSE,CLIPS_FALSE);
   DefineFunction2("(set-evaluation-error)", 
                                       'w', PTIF CauseEvaluationError,"CauseEvaluationError",NULL);
   DefineFunction2("set-sequence-operator-recognition",
                                       'b', PTIF SetSORCommand,"SetSORCommand","11w");
   DefineFunction2("get-sequence-operator-recognition",'b',
                    PTIF GetSequenceOperatorRecognition,"GetSequenceOperatorRecognition","00");
   DefineFunction2("get-function-restrictions",'s',
                   PTIF GetFunctionRestrictions,"GetFunctionRestrictions","11w");
   DefineFunction2("create$",     'm', PTIF CreateFunction,  "CreateFunction", NULL);
   DefineFunction2("mv-append",   'm', PTIF CreateFunction,  "CreateFunction", NULL);
   DefineFunction2("apropos",   'v', PTIF AproposCommand,  "AproposCommand", "11w");
  }
#endif

/******************************************************************/
/* CreateFunction: CLIPS access routine for the create$ function. */
/******************************************************************/
globle VOID CreateFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   StoreInMultifield(returnValue,GetFirstArgument(),CLIPS_TRUE);
  }  

/*****************************************************************/
/* SetgenFunction: CLIPS access routine for the setgen function. */
/*****************************************************************/
globle long int SetgenFunction()
  {
   long theLong;
   DATA_OBJECT theValue;

   /*==========================================================*/
   /* Check to see that a single integer argument is provided. */
   /*==========================================================*/
   
   if (ArgCountCheck("setgen",EXACTLY,1) == -1) return(GensymNumber);
   if (ArgTypeCheck("setgen",1,INTEGER,&theValue) == CLIPS_FALSE) return(GensymNumber);

   /*========================================*/
   /* The integer must be greater than zero. */
   /*========================================*/

   theLong = ValueToLong(theValue.value);

   if (theLong < 1L)
     {
      ExpectedTypeError1("setgen",1,"number (greater than or equal to 1)");
      return(GensymNumber);
     }

   /*====================================*/
   /* Set the gensym index to the number */
   /* provided and return this value.    */
   /*====================================*/
   
   GensymNumber = theLong;
   return(theLong);
  }

/****************************************/
/* GensymFunction: CLIPS access routine */
/*   for the gensym function.           */
/****************************************/
globle VOID *GensymFunction()
  {
   char genstring[15];

   /*===========================================*/
   /* The gensym function accepts no arguments. */
   /*===========================================*/
   
   ArgCountCheck("gensym",EXACTLY,0);

   /*================================================*/
   /* Create a symbol using the current gensym index */
   /* as the postfix.                                */
   /*================================================*/
   
   sprintf(genstring,"gen%ld",GensymNumber);
   GensymNumber++;
   
   /*====================*/
   /* Return the symbol. */
   /*====================*/
   
   return(AddSymbol(genstring));
  }

/************************************************/
/* GensymStarFunction: CLIPS access routine for */
/*   the gensym* function.                      */
/************************************************/
globle VOID *GensymStarFunction()
  {
   char genstring[15];

   /*============================================*/
   /* The gensym* function accepts no arguments. */
   /*============================================*/
   
   ArgCountCheck("gensym*",EXACTLY,0);
   
   /*=======================================================*/
   /* Create a symbol using the current gensym index as the */
   /* postfix. If the symbol is already present in the      */
   /* symbol table, then continue generating symbols until  */
   /* a unique symbol is found.                             */
   /*=======================================================*/

   do
     {
      sprintf(genstring,"gen%ld",GensymNumber);
      GensymNumber++;
     } 
   while (FindSymbol(genstring) != NULL);

   /*====================*/
   /* Return the symbol. */
   /*====================*/
   
   return(AddSymbol(genstring));
  }

/********************************************/
/* RandomFunction: CLIPS access routine for */
/*   the random function.                   */
/********************************************/
globle long RandomFunction()
  {
   /*===========================================*/
   /* The random function accepts no arguments. */
   /*===========================================*/
   
   ArgCountCheck("random",EXACTLY,0);

   /*========================================*/
   /* Return the randomly generated integer. */
   /*========================================*/
   
   return((long) genrand());
  }

/******************************************/
/* SeedFunction: CLIPS access routine for */
/*   the seed function.                   */
/******************************************/
globle VOID SeedFunction()
  {
   DATA_OBJECT theValue;

   /*==========================================================*/
   /* Check to see that a single integer argument is provided. */
   /*==========================================================*/
   
   if (ArgCountCheck("seed",EXACTLY,1) == -1) return;
   if (ArgTypeCheck("seed",1,INTEGER,&theValue) == CLIPS_FALSE) return;

   /*=============================================================*/
   /* Seed the random number generator with the provided integer. */
   /*=============================================================*/
   
   genseed((int) DOToLong(theValue));
  }

/********************************************/
/* LengthFunction: CLIPS access routine for */
/*   the length$ function.                  */
/********************************************/
globle long int LengthFunction()
  {
   DATA_OBJECT item;

   /*====================================================*/
   /* The length$ function expects exactly one argument. */
   /*====================================================*/
   
   if (ArgCountCheck("length$",EXACTLY,1) == -1) return(-1L);
   RtnUnknown(1,&item);

   /*====================================================*/
   /* If the argument is a string or symbol, then return */
   /* the number of characters in the argument.          */
   /*====================================================*/
   
   if ((GetType(item) == STRING) || (GetType(item) == SYMBOL))
     {  return( (long) strlen(DOToString(item))); }
   
   /*====================================================*/
   /* If the argument is a multifield value, then return */
   /* the number of fields in the argument.              */
   /*====================================================*/
   
   if (GetType(item) == MULTIFIELD)
     { return ( (long) GetDOLength(item)); }
   
   /*=============================================*/
   /* If the argument wasn't a string, symbol, or */
   /* multifield value, then generate an error.   */
   /*=============================================*/
   
   SetEvaluationError(CLIPS_TRUE);
   ExpectedTypeError2("length$",1);
   return(-1L);
  }

/*******************************************/
/* ReleaseMemCommand: CLIPS access routine */
/*   for the release-mem function.         */
/*******************************************/
globle long ReleaseMemCommand()
  {
   /*================================================*/
   /* The release-mem function accepts no arguments. */
   /*================================================*/
   
   if (ArgCountCheck("release-mem",EXACTLY,0) == -1) return(0);
   
   /*========================================*/
   /* Release memory to the operating system */
   /* and return the amount of memory freed. */
   /*========================================*/
   
   return(ReleaseMem(-1L,CLIPS_FALSE));
  }

/********************************************/
/* ConserveMemCommand: CLIPS access routine */
/*   for the conserve-mem command.          */
/********************************************/
globle VOID ConserveMemCommand()
  {
   char *argument;
   DATA_OBJECT theValue;

   /*===================================*/
   /* The conserve-mem function expects */
   /* a single symbol argument.         */
   /*===================================*/
   
   if (ArgCountCheck("conserve-mem",EXACTLY,1) == -1) return;
   if (ArgTypeCheck("conserve-mem",1,SYMBOL,&theValue) == CLIPS_FALSE) return;

   argument = DOToString(theValue);

   /*====================================================*/
   /* If the argument is the symbol "on", then store the */
   /* pretty print representation of a construct when it */
   /* is defined.                                        */
   /*====================================================*/
   
   if (strcmp(argument,"on") == 0)
     { SetConserveMemory(CLIPS_TRUE); }
     
   /*======================================================*/
   /* Otherwise, if the argument is the symbol "off", then */
   /* don't store the pretty print representation of a     */
   /* construct when it is defined.                        */
   /*======================================================*/

   else if (strcmp(argument,"off") == 0)
     { SetConserveMemory(CLIPS_FALSE); }