prcdrpsr.c

clips源代码

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.24  06/05/06            */
   /*                                                     */
   /*          PROCEDURAL FUNCTIONS PARSER MODULE         */
   /*******************************************************/

/*************************************************************/
/* Purpose:                                                  */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*      6.23: Changed name of variable exp to theExp         */
/*            because of Unix compiler warnings of shadowed  */
/*            definitions.                                   */
/*                                                           */
/*      6.24: Renamed BOOLEAN macro type to intBool.         */
/*                                                           */
/*************************************************************/

#define _PRCDRPSR_SOURCE_

#include <stdio.h>
#define _STDIO_INCLUDED_

#include "setup.h"

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

#include "prcdrpsr.h"

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

#if ! RUN_TIME
#define PRCDRPSR_DATA 12

struct procedureParserData
  { 
   struct BindInfo *ListOfParsedBindNames;
  };

#define ProcedureParserData(theEnv) ((struct procedureParserData *) GetEnvironmentData(theEnv,PRCDRPSR_DATA))
#endif

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

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

#if ! RUN_TIME
/*******************************************/
/* ProceduralFunctionParsers        */
/*******************************************/
globle void ProceduralFunctionParsers(
  void *theEnv)
  {
   AllocateEnvironmentData(theEnv,PRCDRPSR_DATA,sizeof(struct procedureParserData),DeallocateProceduralFunctionData);

#if (! BLOAD_ONLY)
   AddFunctionParser(theEnv,"bind",BindParse);
   AddFunctionParser(theEnv,"progn",PrognParse);
   AddFunctionParser(theEnv,"if",IfParse);
   AddFunctionParser(theEnv,"while",WhileParse);
   AddFunctionParser(theEnv,"loop-for-count",LoopForCountParse);
   AddFunctionParser(theEnv,"return",ReturnParse);
   AddFunctionParser(theEnv,"break",BreakParse);
   AddFunctionParser(theEnv,"switch",SwitchParse);
#endif
  }

/*************************************************************/
/* DeallocateProceduralFunctionData: Deallocates environment */
/*    data for procedural functions.                         */
/*************************************************************/
static void DeallocateProceduralFunctionData(
  void *theEnv)
  { 
   struct BindInfo *temp_bind;

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

/********************************************************/
/* GetParsedBindNames:                                      */
/********************************************************/
globle struct BindInfo *GetParsedBindNames(
  void *theEnv)
  {
   return(ProcedureParserData(theEnv)->ListOfParsedBindNames);
  }

/********************************************************/
/* SetParsedBindNames:                                      */
/********************************************************/
globle void SetParsedBindNames(
  void *theEnv,
  struct BindInfo *newValue)
  {
   ProcedureParserData(theEnv)->ListOfParsedBindNames = newValue;
  }

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

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

/********************************************************/
/* ParsedBindNamesEmpty:                                     */
/********************************************************/
globle intBool ParsedBindNamesEmpty(
  void *theEnv)
  {
   if (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL) return(FALSE);

   return(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(
  void *theEnv,
  struct expr *parse,
  char *infile)
  {
   struct token theToken;
   int read_first_paren;

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

   SavePPBuffer(theEnv," ");

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

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

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

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

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

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

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

   DecrementIndentDepth(theEnv,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(
  void *theEnv,
  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(theEnv," ");
   GetToken(theEnv,infile,&theToken);

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

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