prcdrpsr.c

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

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

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

#define _PRCDRPSR_SOURCE_

#include <stdio.h>
#define _CLIPS_STDIO_

#include "setup.h"

#include "clipsmem.h"
#include "router.h"
#include "argacces.h"
#include "constrnt.h"
#include "cstrnchk.h"
#include "cstrnops.h"
#include "multifld.h"
#include "exprnpsr.h"
#include "scanner.h"
#include "utility.h"
#include "modulutl.h"
#include "cstrnutl.h"

#include "prcdrpsr.h"

#if DEFGLOBAL_CONSTRUCT 
#include "globldef.h" 
#include "globlpsr.h"
#endif

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

#if (! RUN_TIME) && (! BLOAD_ONLY)
#if ANSI_COMPILER
   static struct expr            *WhileParse(struct expr *,char *);
   static struct expr            *LoopForCountParse(struct expr *,char *);
   static VOID                    ReplaceLoopCountVars(SYMBOL_HN *,EXPRESSION *,int);
   static struct expr            *IfParse(struct expr *,char *);
   static struct expr            *PrognParse(struct expr *,char *);
   static struct expr            *BindParse(struct expr *,char *);
   static int                     AddBindName(struct symbolHashNode *,CONSTRAINT_RECORD *);
   static struct expr            *ReturnParse(struct expr *,char *);
   static struct expr            *BreakParse(struct expr *,char *);
   static struct expr            *SwitchParse(struct expr *,char *);
#else
   static struct expr            *WhileParse();
   static struct expr            *LoopForCountParse();
   static VOID                    ReplaceLoopCountVars();
   static struct expr            *IfParse();
   static struct expr            *PrognParse();
   static struct expr            *BindParse();
   static int                     AddBindName();
   static struct expr            *ReturnParse();
   static struct expr            *BreakParse();
   static struct expr            *SwitchParse();
#endif
#endif

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

#if (! RUN_TIME)
   static struct BindInfo   *ListOfParsedBindNames;
#endif

#if ! RUN_TIME
/*******************************************/
/* ProceduralFunctionParsers        */
/*******************************************/
globle VOID ProceduralFunctionParsers()
  {
#if (! BLOAD_ONLY)
   AddFunctionParser("bind",BindParse);
   AddFunctionParser("progn",PrognParse);
   AddFunctionParser("if",IfParse);
   AddFunctionParser("while",WhileParse);
   AddFunctionParser("loop-for-count",LoopForCountParse);
   AddFunctionParser("return",ReturnParse);
   AddFunctionParser("break",BreakParse);
   AddFunctionParser("switch",SwitchParse);
#endif
  }
  
/********************************************************/
/* GetParsedBindNames:                                      */
/********************************************************/
globle struct BindInfo *GetParsedBindNames()
  {
   return(ListOfParsedBindNames);
  }

/********************************************************/
/* SetParsedBindNames:                                      */
/********************************************************/
globle VOID SetParsedBindNames(newValue)
  struct BindInfo *newValue;
  {
   ListOfParsedBindNames = newValue;
  }

/********************************************************/
/* ClearParsedBindNames:                                     */
/********************************************************/
globle VOID ClearParsedBindNames()
  {
   struct BindInfo *temp_bind;

   while (ListOfParsedBindNames != NULL)
     {
      temp_bind = ListOfParsedBindNames->next;
      RemoveConstraint(ListOfParsedBindNames->constraints);
      rtn_struct(BindInfo,ListOfParsedBindNames);
      ListOfParsedBindNames = temp_bind;
     }
  }

/********************************************************/
/* ParsedBindNamesEmpty:                                     */
/********************************************************/
globle BOOLEAN ParsedBindNamesEmpty()
  {
   if (ListOfParsedBindNames != NULL) return(CLIPS_FALSE);

   return(CLIPS_TRUE);
  }

#if (! BLOAD_ONLY)
   
/*********************************************************/
/* WhileParse: purpose is to parse the while statement.  */
/*   The parse of the statement is the return value.     */
/*   Syntax: (while <expression> do <action>+)           */
/*********************************************************/
static struct expr *WhileParse(parse,infile)
  struct expr *parse;
  char *infile;
  {
   struct token theToken;
   int read_first_paren;

   /*===============================*/
   /* Process the while expression. */
   /*===============================*/

   SavePPBuffer(" ");

   parse->argList = ParseAtomOrExpression(infile,NULL);
   if (parse->argList == NULL)
     {
      ReturnExpression(parse);
      return(NULL);
     }

   /*====================================*/
   /* Process the do keyword if present. */
   /*====================================*/

   GetToken(infile,&theToken);
   if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0))
     {
      read_first_paren = CLIPS_TRUE;
      PPBackup();
      SavePPBuffer(" ");
      SavePPBuffer(theToken.printForm);
      IncrementIndentDepth(3);
      PPCRAndIndent();
     }
   else if (theToken.type == LPAREN)
     {
      read_first_paren = CLIPS_FALSE;
      PPBackup();
      IncrementIndentDepth(3);
      PPCRAndIndent();
      SavePPBuffer(theToken.printForm);
     }
   else
     {
      SyntaxErrorMessage("while function");
      ReturnExpression(parse);
      return(NULL);
     }

   /*============================*/
   /* Process the while actions. */
   /*============================*/
   if (svContexts->rtn == CLIPS_TRUE) 
     ReturnContext = CLIPS_TRUE;
   BreakContext = CLIPS_TRUE;
   parse->argList->nextArg = GroupActions(infile,&theToken,read_first_paren,NULL);

   if (parse->argList->nextArg == NULL)
     {
      ReturnExpression(parse);
      return(NULL);
     }
   PPBackup();
   PPBackup();
   SavePPBuffer(theToken.printForm);

   /*=======================================================*/
   /* Check for the closing right parenthesis of the while. */
   /*=======================================================*/

   if (theToken.type != RPAREN)
     {
      SyntaxErrorMessage("while function");
      ReturnExpression(parse);
      return(NULL);
     }

   DecrementIndentDepth(3);

   return(parse);
  }

/******************************************************************************************/
/* LoopForCountParse: purpose is to parse the loop-for-count statement.                   */
/*   The parse of the statement is the return value.                                      */
/*   Syntax: (loop-for-count <range> [do] <action>+)                                      */
/*           <range> ::= (<sf-var> [<start-integer-expression>] <end-integer-expression>) */
/******************************************************************************************/
static struct expr *LoopForCountParse(parse,infile)
  struct expr *parse;
  char *infile;
  {
   struct token theToken;
   SYMBOL_HN *loopVar = NULL;
   EXPRESSION *tmpexp;
   int read_first_paren;
   struct BindInfo *oldBindList,*newBindList,*prev;

   /*======================================*/
   /* Process the loop counter expression. */
   /*======================================*/

   SavePPBuffer(" ");
   GetToken(infile,&theToken);
   
   /* ==========================================
      Simple form: loop-for-count <end> [do] ...
      ========================================== */
   if (theToken.type != LPAREN)
     {
      parse->argList = GenConstant(INTEGER,AddLong(1L));
      parse->argList->nextArg = ParseAtomOrExpression(infile,&theToken);
      if (parse->argList->nextArg == NULL)
        {
         ReturnExpression(parse);
         return(NULL);
        }
     }
   else
     {
      GetToken(infile,&theToken);
      if (theToken.type != SF_VARIABLE)
        {
         if (theToken.type != SYMBOL)
           goto LoopForCountParseError;
         parse->argList = GenConstant(INTEGER,AddLong(1L));
         parse->argList->nextArg = Function2Parse(infile,ValueToString(theToken.value));
         if (parse->argList->nextArg == NULL)
           {
            ReturnExpression(parse);
            return(NULL);
           }
        }

      /* =============================================================
         Complex form: loop-for-count (<var> [<start>] <end>) [do] ...
         ============================================================= */
      else
        {
         loopVar = (SYMBOL_HN *) theToken.value;
         SavePPBuffer(" ");
         parse->argList = ParseAtomOrExpression(infile,NULL);
         if (parse->argList == NULL)
           {
            ReturnExpression(parse);
            return(NULL);
           }
         if (CheckArgumentAgainstRestriction(parse->argList,(int) 'i'))
           goto LoopForCountParseError;
         SavePPBuffer(" ");
         GetToken(infile,&theToken);
         if (theToken.type == RPAREN)
           {
            PPBackup();
            PPBackup();
            SavePPBuffer(theToken.printForm);
            tmpexp = GenConstant(INTEGER,AddLong(1L));
            tmpexp->nextArg = parse->argList;
            parse->argList = tmpexp;
           }
         else
          {
            parse->argList->nextArg = ParseAtomOrExpression(infile,&theToken);
            if (parse->argList->nextArg == NULL)
              {
               ReturnExpression(parse);
               return(NULL);
              }
            GetToken(infile,&theToken);
            if (theToken.type != RPAREN)
              goto LoopForCountParseError;
           }
         SavePPBuffer(" ");
        }
     }

   if (CheckArgumentAgainstRestriction(parse->argList->nextArg,(int) 'i'))
     goto LoopForCountParseError;

   /*====================================*/
   /* Process the do keyword if present. */
   /*====================================*/

   GetToken(infile,&theToken);
   if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0))
     {
      read_first_paren = CLIPS_TRUE;
      PPBackup();
      SavePPBuffer(" ");
      SavePPBuffer(theToken.printForm);
      IncrementIndentDepth(3);
      PPCRAndIndent();
     }
   else if (theToken.type == LPAREN)
     {
      read_first_paren = CLIPS_FALSE;
      PPBackup();
      IncrementIndentDepth(3);
      PPCRAndIndent();
      SavePPBuffer(theToken.printForm);
     }
   else
     goto LoopForCountParseError;

   /*=====================================*/
   /* Process the loop-for-count actions. */
   /*=====================================*/
   if (svContexts->rtn == CLIPS_TRUE) 
     ReturnContext = CLIPS_TRUE;
   BreakContext = CLIPS_TRUE;
   oldBindList = GetParsedBindNames();
   SetParsedBindNames(NULL);
   parse->argList->nextArg->nextArg = GroupActions(infile,&theToken,read_first_paren,NULL);

   if (parse->argList->nextArg->nextArg == NULL)
     {
      SetParsedBindNames(oldBindList);
      ReturnExpression(parse);
      return(NULL);
     }
   newBindList = GetParsedBindNames();
   prev = NULL;
   while (newBindList != NULL)
     {
      if ((loopVar == NULL) ? CLIPS_FALSE :
          (strcmp(ValueToString(newBindList->name),ValueToString(loopVar)) == 0))
        {
         ClearParsedBindNames();
         SetParsedBindNames(oldBindList);
         PrintErrorID("PRCDRPSR",1,CLIPS_TRUE);
         PrintCLIPS(WERROR,"Cannot rebind loop variable in function loop-for-count.\n");
         ReturnExpression(parse);
         return(NULL);
        }
      prev = newBindList;
      newBindList = newBindList->next;
     }
   if (prev == NULL)
     SetParsedBindNames(oldBindList);
   else
     prev->next = oldBindList;
   if (loopVar != NULL)
     ReplaceLoopCountVars(loopVar,parse->argList->nextArg->nextArg,0);
   PPBackup();
   PPBackup();
   SavePPBuffer(theToken.printForm);

   /*================================================================*/
   /* Check for the closing right parenthesis of the loop-for-count. */
   /*================================================================*/

   if (theToken.type != RPAREN)
     {
      SyntaxErrorMessage("loop-for-count function");
      ReturnExpression(parse);
      return(NULL);
     }

   DecrementIndentDepth(3);

   return(parse);
   
LoopForCountParseError:
   SyntaxErrorMessage("loop-for-count function");
   ReturnExpression(parse);
   return(NULL);
  }

/***************************************************/
/* ReplaceLoopCountVars                            */
/***************************************************/
static VOID ReplaceLoopCountVars(loopVar,exp,depth)
  SYMBOL_HN *loopVar;
  EXPRESSION *exp;
  int depth;
  {
   while (exp != NULL)
     {
      if ((exp->type != SF_VARIABLE) ? CLIPS_FALSE :
          (strcmp(ValueToString(exp->value),ValueToString(loopVar)) == 0))
        {
         exp->type = FCALL;
         exp->value = (VOID *) FindFunction("(get-loop-count)");
         exp->argList = GenConstant(INTEGER,AddLong((long) depth));
        }
      else if (exp->argList != NULL)
        {
         if ((exp->type != FCALL) ? CLIPS_FALSE :
             (exp->value == (VOID *) FindFunction("loop-for-count")))
           ReplaceLoopCountVars(loopVar,exp->argList,depth+1);
         else
           ReplaceLoopCountVars(loopVar,exp->argList,depth);
        }
      exp = exp->nextArg;
     }
  }

/*********************************************************/
/* IfParse: purpose is to parse the if statement.  The  */
/*   parse of the statement is the return value.         */
/*   Syntax: (if <expression> then <action>+             */
/*               [ else <action>+ ] )                    */
/*********************************************************/
static struct expr *IfParse(top,infile)
  struct expr *top;
  char *infile;
  {
   struct token theToken;

   /*============================*/
   /* Process the if expression. */
   /*============================*/

   SavePPBuffer(" ");

   top->argList = ParseAtomOrExpression(infile,NULL);

   if (top->argList == NULL)
     {
      ReturnExpression(top);
      return(NULL);
     }

   /*========================================*/
   /* Keyword 'then' must follow expression. */
   /*========================================*/

   IncrementIndentDepth(3);
   PPCRAndIndent();

   GetToken(infile,&theToken);
   if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"then") != 0))
     {
      SyntaxErrorMessage("if function");
      ReturnExpression(top);
      return(NULL);
     }

   /*==============================*/
   /* Process the if then actions. */
   /*==============================*/

   PPCRAndIndent();
   if (svContexts->rtn == CLIPS_TRUE)
     ReturnContext = CLIPS_TRUE;
   if (svContexts->brk == CLIPS_TRUE)
     BreakContext = CLIPS_TRUE;
   top->argList->nextArg = GroupActions(infile,&theToken,CLIPS_TRUE,"else");

   if (top->argList->nextArg == NULL)
     {
      ReturnExpression(top);