inspsr.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*              CLIPS Version 6.05  04/09/97           */
   /*                                                     */
   /*                INSTANCE PARSER MODULE               */
   /*******************************************************/

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

#if OBJECT_SYSTEM

#ifndef _CLIPS_STDIO_
#define _CLIPS_STDIO_
#include <stdio.h>
#endif

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

#include "classcom.h"
#include "classfun.h"
#include "classinf.h"
#include "constant.h"
#include "moduldef.h"
#include "evaluatn.h"
#include "exprnpsr.h"
#include "extnfunc.h"
#include "prntutil.h"
#include "router.h"

#define _INSPSR_SOURCE_
#include "inspsr.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */
#define MAKE_TYPE       0
#define INITIALIZE_TYPE 1
#define MODIFY_TYPE     2
#define DUPLICATE_TYPE  3

#define CLASS_RLN          "of"
#define DUPLICATE_NAME_REF "to"

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

static BOOLEAN ReplaceClassNameWithReference(EXPRESSION *);

#else

static BOOLEAN ReplaceClassNameWithReference();

#endif

/* =========================================
   *****************************************
       EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
#if (! BLOAD_ONLY) && (! RUN_TIME)
extern struct token ObjectParseToken;
#else
globle struct token ObjectParseToken;
#endif

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

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
  
#if ! RUN_TIME

/*************************************************************************************
  NAME         : ParseInitializeInstance
  DESCRIPTION  : Parses initialize-instance and make-instance function
                   calls into an EXPRESSION form that
                   can later be evaluated with EvaluateExpression()
  INPUTS       : 1) The address of the top node of the expression
                    containing the initialize-instance function call
                 2) The logical name of the input source
  RETURNS      : The address of the modified expression, or NULL
                    if there is an error
  SIDE EFFECTS : The expression is enhanced to include all
                    aspects of the initialize-instance call
                    (slot-overrides etc.)
                 The "top" expression is deleted on errors.
  NOTES        : This function parses a initialize-instance call into
                 an expression of the following form :
                 
                 (initialize-instance <instance-name> <slot-override>*)
                  where <slot-override> ::= (<slot-name> <expression>+)
                  
                  goes to -->
                  
                  initialize-instance
                      |
                      V
                  <instance or name>-><slot-name>-><dummy-node>...
                                                      |
                                                      V
                                               <value-expression>...
                                             
                  (make-instance <instance> of <class> <slot-override>*)
                  goes to -->
                  
                  make-instance
                      |
                      V
                  <instance-name>-><class-name>-><slot-name>-><dummy-node>...
                                                                 |
                                                                 V
                                                          <value-expression>...

                  (make-instance of <class> <slot-override>*)
                  goes to -->
                  
                  make-instance
                      |
                      V
                  (gensym*)-><class-name>-><slot-name>-><dummy-node>...
                                                                 |
                                                                 V
                                                          <value-expression>...

                  (modify-instance <instance> <slot-override>*)
                  goes to -->
                  
                  modify-instance
                      |
                      V
                  <instance or name>-><slot-name>-><dummy-node>...
                                                      |
                                                      V
                                               <value-expression>...

                  (duplicate-instance <instance> [to <new-name>] <slot-override>*)
                  goes to -->
                  
                  duplicate-instance
                      |
                      V
                  <instance or name>-><new-name>-><slot-name>-><dummy-node>...
                                          OR                         |
                                      (gensym*)                      V
                                                           <value-expression>...

 *************************************************************************************/
globle EXPRESSION *ParseInitializeInstance(top,readSource)
  EXPRESSION *top;
  char *readSource;
  {
   int error,fcalltype,readclass;
   
   if ((top->value == (VOID *) FindFunction("make-instance")) ||
       (top->value == (VOID *) FindFunction("active-make-instance")))
     fcalltype = MAKE_TYPE;
   else if ((top->value == (VOID *) FindFunction("initialize-instance")) ||
            (top->value == (VOID *) FindFunction("active-initialize-instance")))
     fcalltype = INITIALIZE_TYPE;
   else if ((top->value == (VOID *) FindFunction("modify-instance")) ||
            (top->value == (VOID *) FindFunction("active-modify-instance")) ||
            (top->value == (VOID *) FindFunction("message-modify-instance")) ||
            (top->value == (VOID *) FindFunction("active-message-modify-instance")))
     fcalltype = MODIFY_TYPE;
   else
     fcalltype = DUPLICATE_TYPE;
   IncrementIndentDepth(3);
   error = CLIPS_FALSE;
   if (top->type == UNKNOWN_VALUE)
     top->type = FCALL;
   else
     SavePPBuffer(" ");
   top->argList = ArgumentParse(readSource,&error);
   if (error)
     goto ParseInitializeInstanceError;
   else if (top->argList == NULL)
     {
      SyntaxErrorMessage("instance");
      goto ParseInitializeInstanceError;
     }
   SavePPBuffer(" ");
   
   if (fcalltype == MAKE_TYPE)
     {
      /* ======================================
         Handle the case of anonymous instances
         where the name was not specified
         ====================================== */
      if ((top->argList->type != SYMBOL) ? CLIPS_FALSE :
          (strcmp(ValueToString(top->argList->value),CLASS_RLN) == 0))
        {
         top->argList->nextArg = ArgumentParse(readSource,&error);
         if (error == CLIPS_TRUE)
           goto ParseInitializeInstanceError;
         if (top->argList->nextArg == NULL)
           {
            SyntaxErrorMessage("instance class");
            goto ParseInitializeInstanceError;
           }
         if ((top->argList->nextArg->type != SYMBOL) ? CLIPS_TRUE :
             (strcmp(ValueToString(top->argList->nextArg->value),CLASS_RLN) != 0))
           {
            top->argList->type = FCALL;
            top->argList->value = (VOID *) FindFunction("gensym*");
            readclass = CLIPS_FALSE;
           }
         else
           readclass = CLIPS_TRUE;
        }
      else
        {
         GetToken(readSource,&ObjectParseToken);
         if ((GetType(ObjectParseToken) != SYMBOL) ? CLIPS_TRUE :
             (strcmp(CLASS_RLN,DOToString(ObjectParseToken)) != 0))
           {
            SyntaxErrorMessage("make-instance");
            goto ParseInitializeInstanceError;
           }
         SavePPBuffer(" ");
         readclass = CLIPS_TRUE;
        }
      if (readclass)
        {
         top->argList->nextArg = ArgumentParse(readSource,&error);
         if (error)
           goto ParseInitializeInstanceError;
         if (top->argList->nextArg == NULL)
           {
            SyntaxErrorMessage("instance class");
            goto ParseInitializeInstanceError;
           }
        }
        
      /* ==============================================
         If the class name is a constant, go ahead and
         look it up now and replace it with the pointer
         ============================================== */
      if (ReplaceClassNameWithReference(top->argList->nextArg) == CLIPS_FALSE)
        goto ParseInitializeInstanceError;

      PPCRAndIndent();
      GetToken(readSource,&ObjectParseToken);
      top->argList->nextArg->nextArg = 
                  ParseSlotOverrides(readSource,&error);
     }
   else
     {
      PPCRAndIndent();
      GetToken(readSource,&ObjectParseToken);
      if (fcalltype == DUPLICATE_TYPE)
        {
         if ((ObjectParseToken.type != SYMBOL) ? CLIPS_FALSE :
             (strcmp(DOToString(ObjectParseToken),DUPLICATE_NAME_REF) == 0))
           {