msgpsr.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*               CLIPS Version 6.05  04/09/97          */
   /*                                                     */
   /*              MESSAGE-HANDLER PARSER FUNCTIONS       */
   /*******************************************************/

/*************************************************************/
/* Purpose:                                                  */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/
   
/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME)

#if ANSI_COMPILER
#include <string.h>
#endif

#if BLOAD || BLOAD_AND_BSAVE
#include "bload.h"
#endif

#include "classcom.h"
#include "classfun.h"
#include "clipsmem.h"
#include "constrct.h"
#include "cstrcpsr.h"
#include "cstrnchk.h"
#include "exprnpsr.h"
#include "insfun.h"
#include "msgfun.h"
#include "pprint.h"
#include "prccode.h"
#include "router.h"
#include "scanner.h"
#include "strngrtr.h"

#define _MSGPSR_SOURCE_
#include "msgpsr.h"

extern struct token ObjectParseToken;

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */
#define SELF_LEN         4
#define SELF_SLOT_REF   ':'

/* =========================================
   *****************************************
               MACROS AND TYPES
   =========================================
   ***************************************** */

/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */
#if ANSI_COMPILER

static BOOLEAN IsParameterSlotReference(char *);
static int SlotReferenceVar(EXPRESSION *,VOID *);
static int BindSlotReference(EXPRESSION *,VOID *);
static SLOT_DESC *CheckSlotReference(DEFCLASS *,int,VOID *,BOOLEAN,EXPRESSION *);
static VOID GenHandlerSlotReference(EXPRESSION *,int,SLOT_DESC *);

#else

static BOOLEAN IsParameterSlotReference();
static int SlotReferenceVar();
static int BindSlotReference();
static SLOT_DESC *CheckSlotReference();
static VOID GenHandlerSlotReference();

#endif
      
/* =========================================
   *****************************************
      EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
globle SYMBOL_HN *SELF_SYMBOL = NULL;

/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
   
/***********************************************************************
  NAME         : ParseDefmessageHandler
  DESCRIPTION  : Parses a message-handler for a class of objects
  INPUTS       : The logical name of the input source
  RETURNS      : CLIPS_FALSE if successful parse, CLIPS_TRUE otherwise
  SIDE EFFECTS : Handler allocated and inserted into class
  NOTES        : CLIPS Syntax:
  
                 (defmessage-handler <class> <name> [<type>] [<comment>]
                    (<params>)
                    <action>*)
                    
                 <params> ::= <var>* | <var>* $?<name>
 ***********************************************************************/
globle int ParseDefmessageHandler(readSource)
  char *readSource;
  {
   DEFCLASS *cls;
   SYMBOL_HN *cname,*mname,*wildcard;
   unsigned mtype = MPRIMARY;
   int min,max,error,lvars;
   EXPRESSION *hndParams,*actions;
   HANDLER *hnd;
   
   SetPPBufferStatus(ON);
   FlushPPBuffer();          
   SetIndentDepth(3);    
   SavePPBuffer("(defmessage-handler ");
   
#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded())
     {      
      CannotLoadWithBloadMessage("defmessage-handler");
      return(CLIPS_TRUE);
     }
#endif
   cname = GetConstructNameAndComment(readSource,&ObjectParseToken,"defmessage-handler",
                                      NULL,NULL,"~",CLIPS_TRUE,CLIPS_FALSE,CLIPS_TRUE);
   if (cname == NULL)
     return(CLIPS_TRUE);
   cls = LookupDefclassByMdlOrScope(ValueToString(cname));
   if (cls == NULL)
     {
      PrintErrorID("MSGPSR",1,CLIPS_FALSE);
      PrintCLIPS(WERROR,"A class must be defined before its message-handlers.\n");
      return(CLIPS_TRUE);
     }
   if ((cls == PrimitiveClassMap[INSTANCE_NAME]) ||
       (cls == PrimitiveClassMap[INSTANCE_ADDRESS]) ||
       (cls == PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]))
     {
      PrintErrorID("MSGPSR",8,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Message-handlers cannot be attached to the class ");
      PrintCLIPS(WERROR,GetDefclassName((VOID *) cls));
      PrintCLIPS(WERROR,".\n");
      return(CLIPS_TRUE);
     }
   if (HandlersExecuting(cls))
     {
      PrintErrorID("MSGPSR",2,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Cannot (re)define message-handlers during execution of \n");
      PrintCLIPS(WERROR,"  other message-handlers for the same class.\n");
      return(CLIPS_TRUE);
     }
   if (GetType(ObjectParseToken) != SYMBOL)
     {
      SyntaxErrorMessage("defmessage-handler");
      return(CLIPS_TRUE);
     }
   PPBackup();
   PPBackup();
   SavePPBuffer(" ");
   SavePPBuffer(ObjectParseToken.print_rep);
   SavePPBuffer(" ");
   mname = (SYMBOL_HN *) GetValue(ObjectParseToken);
   GetToken(readSource,&ObjectParseToken);
   if (GetType(ObjectParseToken) != LPAREN)
     {
      SavePPBuffer(" ");
      if (GetType(ObjectParseToken) != STRING)
        {
         if (GetType(ObjectParseToken) != SYMBOL)
           {
            SyntaxErrorMessage("defmessage-handler");
            return(CLIPS_TRUE);
           }
         mtype = HandlerType("defmessage-handler",DOToString(ObjectParseToken));
         if (mtype == MERROR)
           return(CLIPS_TRUE);
#if ! IMPERATIVE_MESSAGE_HANDLERS
         if (mtype == MAROUND)
           return(CLIPS_TRUE);
#endif
         GetToken(readSource,&ObjectParseToken);
         if (GetType(ObjectParseToken) == STRING)
           {
            SavePPBuffer(" ");
            GetToken(readSource,&ObjectParseToken);
           }
        }
      else
        {
         SavePPBuffer(" ");
         GetToken(readSource,&ObjectParseToken);
        }
     }
   PPBackup();
   PPBackup();
   PPCRAndIndent();
   SavePPBuffer(ObjectParseToken.print_rep);

   hnd = FindHandlerByAddress(cls,mname,mtype);
   if (GetPrintWhileLoading() && GetCompilationsWatch())
     {
      PrintCLIPS(WDIALOG,"   Handler ");
      PrintCLIPS(WDIALOG,ValueToString(mname));
      PrintCLIPS(WDIALOG," ");
      PrintCLIPS(WDIALOG,hndquals[mtype]);
      PrintCLIPS(WDIALOG,(hnd == NULL) ? " defined.\n" : " redefined.\n");
     }
   
   if ((hnd != NULL) ? hnd->system : CLIPS_FALSE)
     {
      PrintErrorID("MSGPSR",3,CLIPS_FALSE);
      PrintCLIPS(WERROR,"System message-handlers may not be modified.\n");
      return(CLIPS_TRUE);
     }
      
   hndParams = GenConstant(SYMBOL,(VOID *) SELF_SYMBOL);
   hndParams = ParseProcParameters(readSource,&ObjectParseToken,hndParams,
                                    &wildcard,&min,&max,&error,IsParameterSlotReference);
   if (error)
     return(CLIPS_TRUE);
   PPCRAndIndent();
   ReturnContext = CLIPS_TRUE;
   actions = ParseProcActions("message-handler",readSource,
                              &ObjectParseToken,hndParams,wildcard,
                              SlotReferenceVar,BindSlotReference,&lvars,
                              (VOID *) cls);
   if (actions == NULL)
     {
      ReturnExpression(hndParams);
      return(CLIPS_TRUE);
     }
   if (GetType(ObjectParseToken) != RPAREN)
     {
      SyntaxErrorMessage("defmessage-handler");
      ReturnExpression(hndParams);
      ReturnPackedExpression(actions);
      return(CLIPS_TRUE);
     }
   PPBackup();
   PPBackup();
   SavePPBuffer(ObjectParseToken.print_rep);
   SavePPBuffer("\n");

   if (hnd != NULL)
     {
      ExpressionDeinstall(hnd->actions);
      ReturnPackedExpression(hnd->actions);
      if (hnd->ppForm != NULL)
        rm((VOID *) hnd->ppForm,
           (int) (sizeof(char) * (strlen(hnd->ppForm)+1)));
     }
   else
     {
      hnd = InsertHandlerHeader(cls,mname,(int) mtype);
      IncrementSymbolCount(hnd->name);
     }
   ReturnExpression(hndParams);
   
   hnd->minParams = min;
   hnd->maxParams = max;
   hnd->localVarCount = lvars;
   hnd->actions = actions;
   ExpressionInstall(hnd->actions);
#if DEBUGGING_FUNCTIONS

   /* ===================================================
      Old handler trace status is automatically preserved
      =================================================== */
   if (GetConserveMemory() == CLIPS_FALSE)
     hnd->ppForm = CopyPPBuffer();
   else
#endif
     hnd->ppForm = NULL;
   return(CLIPS_FALSE);
  }

/*******************************************************************************
  NAME         : CreateGetAndPutHandlers
  DESCRIPTION  : Creates two message-handlers with
                  the following syntax for the slot:
                  
                 (defmessage-handler <class> get-<slot-name> primary ()
                    ?self:<slot-name>)
                 
                 For single-field slots:
                 
                 (defmessage-handler <class> put-<slot-name> primary (?value)
                    (bind ?self:<slot-name> ?value))
                 
                 For multifield slots:
                 
                 (defmessage-handler <class> put-<slot-name> primary ($?value)
                    (bind ?self:<slot-name> ?value))
                    
  INPUTS       : The class slot descriptor
  RETURNS      : Nothing useful
  SIDE EFFECTS : Message-handlers created
  NOTES        : A put handler is not created for read-only slots
 *******************************************************************************/
globle VOID CreateGetAndPutHandlers(sd)
  SLOT_DESC *sd;