Esempio n. 1
0
globle int ParseConstruct(
  void *theEnv,
  char *name,
  char *logicalName)
  {
   struct construct *currentPtr;
   int rv, ov;

   /*=================================*/
   /* Look for a valid construct name */
   /* (e.g. defrule, deffacts).       */
   /*=================================*/

   currentPtr = FindConstruct(theEnv,name);
   if (currentPtr == NULL) return(-1);

   /*==================================*/
   /* Prepare the parsing environment. */
   /*==================================*/

   ov = GetHaltExecution(theEnv);
   SetEvaluationError(theEnv,FALSE);
   SetHaltExecution(theEnv,FALSE);
   ClearParsedBindNames(theEnv);
   PushRtnBrkContexts(theEnv);
   ExpressionData(theEnv)->ReturnContext = FALSE;
   ExpressionData(theEnv)->BreakContext = FALSE;
   EvaluationData(theEnv)->CurrentEvaluationDepth++;

   /*=======================================*/
   /* Call the construct's parsing routine. */
   /*=======================================*/

   ConstructData(theEnv)->ParsingConstruct = TRUE;
   rv = (*currentPtr->parseFunction)(theEnv,logicalName);
   ConstructData(theEnv)->ParsingConstruct = FALSE;

   /*===============================*/
   /* Restore environment settings. */
   /*===============================*/

   EvaluationData(theEnv)->CurrentEvaluationDepth--;
   PopRtnBrkContexts(theEnv);

   ClearParsedBindNames(theEnv);
   SetPPBufferStatus(theEnv,OFF);
   SetHaltExecution(theEnv,ov);

   /*==============================*/
   /* Return the status of parsing */
   /* the construct.               */
   /*==============================*/

   return(rv);
  }
Esempio n. 2
0
/*************************************************************
  NAME         : ParseQueryTestExpression
  DESCRIPTION  : Parses the test-expression for a query
  INPUTS       : 1) The top node of the query expression
                 2) The logical name of the input
  RETURNS      : TRUE if all OK, FALSE otherwise
  SIDE EFFECTS : Entire query-expression deleted on errors
                 Nodes allocated for new expression
                 Test shoved in front of class-restrictions on
                    query argument list
  NOTES        : Expects top != NULL
 *************************************************************/
static int ParseQueryTestExpression(
  void *theEnv,
  EXPRESSION *top,
  const char *readSource)
  {
   EXPRESSION *qtest;
   int error;
   struct BindInfo *oldBindList;

   error = FALSE;
   oldBindList = GetParsedBindNames(theEnv);
   SetParsedBindNames(theEnv,NULL);
   
   qtest = ArgumentParse(theEnv,readSource,&error);
   
   if (error == TRUE)
     {
      ClearParsedBindNames(theEnv);
      SetParsedBindNames(theEnv,oldBindList);
      ReturnExpression(theEnv,top);
      return(FALSE);
     }
   
   if (qtest == NULL)
     {
      ClearParsedBindNames(theEnv);
      SetParsedBindNames(theEnv,oldBindList);
      SyntaxErrorMessage(theEnv,"fact-set query function");
      ReturnExpression(theEnv,top);
      return(FALSE);
     }
   
   qtest->nextArg = top->argList;
   top->argList = qtest;
   
   if (ParsedBindNamesEmpty(theEnv) == FALSE)
     {
      ClearParsedBindNames(theEnv);
      SetParsedBindNames(theEnv,oldBindList);
      PrintErrorID(theEnv,"FACTQPSR",2,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Binds are not allowed in fact-set query in function ");
      EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top)));
      EnvPrintRouter(theEnv,WERROR,".\n");
      ReturnExpression(theEnv,top);
      return(FALSE);
     }
     
   SetParsedBindNames(theEnv,oldBindList);
   
   return(TRUE);
  }
Esempio n. 3
0
globle int CheckSyntax(
  char *theString,
  DATA_OBJECT_PTR returnValue)
  {
   char *name;
   struct token theToken;
   struct expr *top;
   short rv;

   /*==============================*/
   /* Set the default return value */
   /* (TRUE for problems found).   */
   /*==============================*/

   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,TrueSymbol);

   /*===========================================*/
   /* Create a string source router so that the */
   /* string can be used as an input source.    */
   /*===========================================*/

   if (OpenStringSource("check-syntax",theString,0) == 0)
     { return(TRUE); }

   /*=================================*/
   /* Only expressions and constructs */
   /* can have their syntax checked.  */
   /*=================================*/

   GetToken("check-syntax",&theToken);

   if (theToken.type != LPAREN)
     {
      CloseStringSource("check-syntax");
      SetpValue(returnValue,AddSymbol("MISSING-LEFT-PARENTHESIS"));
      return(TRUE);
     }

   /*========================================*/
   /* The next token should be the construct */
   /* type or function name.                 */
   /*========================================*/

   GetToken("check-syntax",&theToken);
   if (theToken.type != SYMBOL)
     {
      CloseStringSource("check-syntax");
      SetpValue(returnValue,AddSymbol("EXPECTED-SYMBOL-AFTER-LEFT-PARENTHESIS"));
      return(TRUE);
     }

   name = ValueToString(theToken.value);

   /*==============================================*/
   /* Set up a router to capture the error output. */
   /*==============================================*/

   AddRouter("error-capture",40,
              FindErrorCapture, PrintErrorCapture,
              NULL, NULL, NULL);

   /*================================*/
   /* Determine if it's a construct. */
   /*================================*/

   if (FindConstruct(name))
     {
      CheckSyntaxMode = TRUE;
      rv = (short) ParseConstruct(name,"check-syntax");
      GetToken("check-syntax",&theToken);
      CheckSyntaxMode = FALSE;

      if (rv)
        {
         PrintRouter(WERROR,"\nERROR:\n");
         PrintInChunks(WERROR,GetPPBuffer());
         PrintRouter(WERROR,"\n");
        }

      DestroyPPBuffer();

      CloseStringSource("check-syntax");

      if ((rv != FALSE) || (WarningString != NULL))
        {
         SetErrorCaptureValues(returnValue);
         DeactivateErrorCapture();
         return(TRUE);
        }

      if (theToken.type != STOP)
        {
         SetpValue(returnValue,AddSymbol("EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
         DeactivateErrorCapture();
         return(TRUE);
        }

      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,FalseSymbol);
      DeactivateErrorCapture();
      return(FALSE);
     }

   /*=======================*/
   /* Parse the expression. */
   /*=======================*/

   top = Function2Parse("check-syntax",name);
   GetToken("check-syntax",&theToken);
   ClearParsedBindNames();
   CloseStringSource("check-syntax");

   if (top == NULL)
     {
      SetErrorCaptureValues(returnValue);
      DeactivateErrorCapture();
      return(TRUE);
     }

   if (theToken.type != STOP)
     {
      SetpValue(returnValue,AddSymbol("EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
      DeactivateErrorCapture();
      ReturnExpression(top);
      return(TRUE);
     }

   DeactivateErrorCapture();

   ReturnExpression(top);
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,FalseSymbol);
   return(FALSE);
  }
Esempio n. 4
0
bool RouteCommand(
  void *theEnv,
  const char *command,
  bool printResult)
  {
   DATA_OBJECT result;
   struct expr *top;
   const char *commandName;
   struct token theToken;
   int danglingConstructs;

   if (command == NULL)
     { return(0); }

   /*========================================*/
   /* Open a string input source and get the */
   /* first token from that source.          */
   /*========================================*/

   OpenStringSource(theEnv,"command",command,0);

   GetToken(theEnv,"command",&theToken);

   /*=====================*/
   /* Evaluate constants. */
   /*=====================*/

   if ((theToken.type == SYMBOL) || (theToken.type == STRING) ||
       (theToken.type == FLOAT) || (theToken.type == INTEGER) ||
       (theToken.type == INSTANCE_NAME))
     {
      CloseStringSource(theEnv,"command");
      if (printResult)
        {
         PrintAtom(theEnv,STDOUT,theToken.type,theToken.value);
         EnvPrintRouter(theEnv,STDOUT,"\n");
        }
      return(1);
     }

   /*=====================*/
   /* Evaluate variables. */
   /*=====================*/

   if ((theToken.type == GBL_VARIABLE) ||
       (theToken.type == SF_VARIABLE) ||
       (theToken.type == MF_VARIABLE))
     {
      CloseStringSource(theEnv,"command");
      top = GenConstant(theEnv,theToken.type,theToken.value);
      EvaluateExpression(theEnv,top,&result);
      rtn_struct(theEnv,expr,top);
      if (printResult)
        {
         PrintDataObject(theEnv,STDOUT,&result);
         EnvPrintRouter(theEnv,STDOUT,"\n");
        }
      return(1);
     }

   /*========================================================*/
   /* If the next token isn't the beginning left parenthesis */
   /* of a command or construct, then whatever was entered   */
   /* cannot be evaluated at the command prompt.             */
   /*========================================================*/

   if (theToken.type != LPAREN)
     {
      PrintErrorID(theEnv,"COMMLINE",1,false);
      EnvPrintRouter(theEnv,WERROR,"Expected a '(', constant, or variable\n");
      CloseStringSource(theEnv,"command");
      return(0);
     }

   /*===========================================================*/
   /* The next token must be a function name or construct type. */
   /*===========================================================*/

   GetToken(theEnv,"command",&theToken);
   if (theToken.type != SYMBOL)
     {
      PrintErrorID(theEnv,"COMMLINE",2,false);
      EnvPrintRouter(theEnv,WERROR,"Expected a command.\n");
      CloseStringSource(theEnv,"command");
      return(0);
     }

   commandName = ValueToString(theToken.value);

   /*======================*/
   /* Evaluate constructs. */
   /*======================*/

#if (! RUN_TIME) && (! BLOAD_ONLY)
   {
    int errorFlag;

    errorFlag = ParseConstruct(theEnv,commandName,"command");
    if (errorFlag != -1)
      {
       CloseStringSource(theEnv,"command");
       if (errorFlag == 1)
         {
          EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
          PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
          EnvPrintRouter(theEnv,WERROR,"\n");
         }
       DestroyPPBuffer(theEnv);
       if (errorFlag) return 0;
       else return 1;
      }
   }
#endif

   /*========================*/
   /* Parse a function call. */
   /*========================*/

   danglingConstructs = ConstructData(theEnv)->DanglingConstructs;
   CommandLineData(theEnv)->ParsingTopLevelCommand = true;
   top = Function2Parse(theEnv,"command",commandName);
   CommandLineData(theEnv)->ParsingTopLevelCommand = false;
   ClearParsedBindNames(theEnv);

   /*================================*/
   /* Close the string input source. */
   /*================================*/

   CloseStringSource(theEnv,"command");

   /*=========================*/
   /* Evaluate function call. */
   /*=========================*/

   if (top == NULL)
     {
      ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
      return false;
     }
   
   ExpressionInstall(theEnv,top);
   
   CommandLineData(theEnv)->EvaluatingTopLevelCommand = true;
   CommandLineData(theEnv)->CurrentCommand = top;
   EvaluateExpression(theEnv,top,&result);
   CommandLineData(theEnv)->CurrentCommand = NULL;
   CommandLineData(theEnv)->EvaluatingTopLevelCommand = false;
   
   ExpressionDeinstall(theEnv,top);
   ReturnExpression(theEnv,top);
   ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
   
   /*=================================================*/
   /* Print the return value of the function/command. */
   /*=================================================*/
   
   if ((result.type != RVOID) && printResult)
     {
      PrintDataObject(theEnv,STDOUT,&result);
      EnvPrintRouter(theEnv,STDOUT,"\n");
     }

   return true;
  }
Esempio n. 5
0
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,1L));
      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,1L));
         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,1L));
            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;
           }
         SavePPBuffer(theEnv," ");
        }
     }

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

   /*====================================*/
   /* 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
     goto LoopForCountParseError;

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

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

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

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

   DecrementIndentDepth(theEnv,3);

   return(parse);

LoopForCountParseError:
   SyntaxErrorMessage(theEnv,"loop-for-count function");
   ReturnExpression(theEnv,parse);
   return(NULL);
  }
Esempio n. 6
0
/*************************************************************
  NAME         : ParseQueryActionExpression
  DESCRIPTION  : Parses the action-expression for a query
  INPUTS       : 1) The top node of the query expression
                 2) The logical name of the input
                 3) List of query parameters
  RETURNS      : TRUE if all OK, FALSE otherwise
  SIDE EFFECTS : Entire query-expression deleted on errors
                 Nodes allocated for new expression
                 Action shoved in front of template-restrictions
                    and in back of test-expression on query
                    argument list
  NOTES        : Expects top != NULL && top->argList != NULL
 *************************************************************/
static int ParseQueryActionExpression(
  void *theEnv,
  EXPRESSION *top,
  const char *readSource,
  EXPRESSION *factQuerySetVars,
  struct token *queryInputToken)
  {
   EXPRESSION *qaction,*tmpFactSetVars;
   struct BindInfo *oldBindList,*newBindList,*prev;

   oldBindList = GetParsedBindNames(theEnv);
   SetParsedBindNames(theEnv,NULL);
   
   ExpressionData(theEnv)->BreakContext = TRUE;
   ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn;

   qaction = GroupActions(theEnv,readSource,queryInputToken,TRUE,NULL,FALSE);
   
   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,queryInputToken->printForm);

   ExpressionData(theEnv)->BreakContext = FALSE;
   
   if (qaction == NULL)
     {
      ClearParsedBindNames(theEnv);
      SetParsedBindNames(theEnv,oldBindList);
      SyntaxErrorMessage(theEnv,"fact-set query function");
      ReturnExpression(theEnv,top);
      return(FALSE);
     }
     
   qaction->nextArg = top->argList->nextArg;
   top->argList->nextArg = qaction;
   
   newBindList = GetParsedBindNames(theEnv);
   prev = NULL;
   while (newBindList != NULL)
     {
      tmpFactSetVars = factQuerySetVars;
      while (tmpFactSetVars != NULL)
        {
         if (tmpFactSetVars->value == (void *) newBindList->name)
           {
            ClearParsedBindNames(theEnv);
            SetParsedBindNames(theEnv,oldBindList);
            PrintErrorID(theEnv,"FACTQPSR",3,FALSE);
            EnvPrintRouter(theEnv,WERROR,"Cannot rebind fact-set member variable ");
            EnvPrintRouter(theEnv,WERROR,ValueToString(tmpFactSetVars->value));
            EnvPrintRouter(theEnv,WERROR," in function ");
            EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top)));
            EnvPrintRouter(theEnv,WERROR,".\n");
            ReturnExpression(theEnv,top);
            return(FALSE);
           }
         tmpFactSetVars = tmpFactSetVars->nextArg;
        }
      prev = newBindList;
      newBindList = newBindList->next;
     }
     
   if (prev == NULL)
     { SetParsedBindNames(theEnv,oldBindList); }
   else
     { prev->next = oldBindList; }
   
   return(TRUE);
  }
Esempio n. 7
0
globle int EnvEval(
  void *theEnv,
  char *theString,
  DATA_OBJECT_PTR returnValue)
  {
   struct expr *top;
   int ov;
   static int depth = 0;
   char logicalNameBuffer[20];
   struct BindInfo *oldBinds;

   /*======================================================*/
   /* Evaluate the string. Create a different logical name */
   /* for use each time the eval function is called.       */
   /*======================================================*/

   depth++;
   sprintf(logicalNameBuffer,"Eval-%d",depth);
   if (OpenStringSource(theEnv,logicalNameBuffer,theString,0) == 0)
     {
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      depth--;
      return(FALSE);
     }

   /*================================================*/
   /* Save the current parsing state before routines */
   /* are called to parse the eval string.           */
   /*================================================*/

   ov = GetPPBufferStatus(theEnv);
   SetPPBufferStatus(theEnv,FALSE);
   oldBinds = GetParsedBindNames(theEnv);
   SetParsedBindNames(theEnv,NULL);

   /*========================================================*/
   /* Parse the string argument passed to the eval function. */
   /*========================================================*/

   top = ParseAtomOrExpression(theEnv,logicalNameBuffer,NULL);

   /*============================*/
   /* Restore the parsing state. */
   /*============================*/

   SetPPBufferStatus(theEnv,ov);
   ClearParsedBindNames(theEnv);
   SetParsedBindNames(theEnv,oldBinds);

   /*===========================================*/
   /* Return if an error occured while parsing. */
   /*===========================================*/

   if (top == NULL)
     {
      SetEvaluationError(theEnv,TRUE);
      CloseStringSource(theEnv,logicalNameBuffer);
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      depth--;
      return(FALSE);
     }

   /*==============================================*/
   /* The sequence expansion operator must be used */
   /* within the argument list of a function call. */
   /*==============================================*/

   if ((top->type == MF_GBL_VARIABLE) || (top->type == MF_VARIABLE))
     {
      PrintErrorID(theEnv,"MISCFUN",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n");
      SetEvaluationError(theEnv,TRUE);
      CloseStringSource(theEnv,logicalNameBuffer);
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      ReturnExpression(theEnv,top);
      depth--;
      return(FALSE);
     }

   /*=======================================*/
   /* The expression to be evaluated cannot */
   /* contain any local variables.          */
   /*=======================================*/

   if (ExpressionContainsVariables(top,FALSE))
     {
      PrintErrorID(theEnv,"STRNGFUN",2,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Some variables could not be accessed by the eval function.\n");
      SetEvaluationError(theEnv,TRUE);
      CloseStringSource(theEnv,logicalNameBuffer);
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,EnvFalseSymbol(theEnv));
      ReturnExpression(theEnv,top);
      depth--;
      return(FALSE);
     }

   /*====================================*/
   /* Evaluate the expression and return */
   /* the memory used to parse it.       */
   /*====================================*/

   ExpressionInstall(theEnv,top);
   EvaluateExpression(theEnv,top,returnValue);
   ExpressionDeinstall(theEnv,top);

   depth--;
   ReturnExpression(theEnv,top);
   CloseStringSource(theEnv,logicalNameBuffer);

   if (GetEvaluationError(theEnv)) return(FALSE);
   return(TRUE);
  }
Esempio n. 8
0
globle int ParseDefrule(
  void *theEnv,
  const char *readSource)
  {
#if (! RUN_TIME) && (! BLOAD_ONLY)
   SYMBOL_HN *ruleName;
   struct lhsParseNode *theLHS;
   struct expr *actions;
   struct token theToken;
   struct defrule *topDisjunct, *tempPtr;
   struct defruleModule *theModuleItem;
   int error;

   /*================================================*/
   /* Flush the buffer which stores the pretty print */
   /* representation for a rule.  Add the already    */
   /* parsed keyword defrule to this buffer.         */
   /*================================================*/

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SavePPBuffer(theEnv,"(defrule ");

   /*=========================================================*/
   /* Rules cannot be loaded when a binary load is in effect. */
   /*=========================================================*/

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defrule");
      return(TRUE);
     }
#endif

   /*================================================*/
   /* Parse the name and comment fields of the rule, */
   /* deleting the rule if it already exists.        */
   /*================================================*/

#if DEBUGGING_FUNCTIONS
   DefruleData(theEnv)->DeletedRuleDebugFlags = 0;
#endif

   ruleName = GetConstructNameAndComment(theEnv,readSource,&theToken,"defrule",
                                         EnvFindDefruleInModule,EnvUndefrule,"*",FALSE,
                                         TRUE,TRUE,FALSE);

   if (ruleName == NULL) return(TRUE);

   /*============================*/
   /* Parse the LHS of the rule. */
   /*============================*/

   theLHS = ParseRuleLHS(theEnv,readSource,&theToken,ValueToString(ruleName),&error);
   if (error)
     {
      ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
      PatternData(theEnv)->SalienceExpression = NULL;
      return(TRUE);
     }

   /*============================*/
   /* Parse the RHS of the rule. */
   /*============================*/

   ClearParsedBindNames(theEnv);
   ExpressionData(theEnv)->ReturnContext = TRUE;
   actions = ParseRuleRHS(theEnv,readSource);

   if (actions == NULL)
     {
      ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
      PatternData(theEnv)->SalienceExpression = NULL;
      ReturnLHSParseNodes(theEnv,theLHS);
      return(TRUE);
     }

   /*=======================*/
   /* Process the rule LHS. */
   /*=======================*/

   topDisjunct = ProcessRuleLHS(theEnv,theLHS,actions,ruleName,&error);

   ReturnExpression(theEnv,actions);
   ClearParsedBindNames(theEnv);
   ReturnLHSParseNodes(theEnv,theLHS);

   if (error)
     {
      ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
      PatternData(theEnv)->SalienceExpression = NULL;
      return(TRUE);
     }

   /*==============================================*/
   /* If we're only checking syntax, don't add the */
   /* successfully parsed defrule to the KB.       */
   /*==============================================*/

   if (ConstructData(theEnv)->CheckSyntaxMode)
     {
      ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
      PatternData(theEnv)->SalienceExpression = NULL;
      return(FALSE);
     }

   PatternData(theEnv)->SalienceExpression = NULL;

   /*======================================*/
   /* Save the nice printout of the rules. */
   /*======================================*/

   SavePPBuffer(theEnv,"\n");
   if (EnvGetConserveMemory(theEnv) == TRUE)
     { topDisjunct->header.ppForm = NULL; }
   else
     { topDisjunct->header.ppForm = CopyPPBuffer(theEnv); }

   /*=======================================*/
   /* Store a pointer to the rule's module. */
   /*=======================================*/

   theModuleItem = (struct defruleModule *)
                   GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defrule")->moduleIndex);

   for (tempPtr = topDisjunct; tempPtr != NULL; tempPtr = tempPtr->disjunct)
     { 
      tempPtr->header.whichModule = (struct defmoduleItemHeader *) theModuleItem; 
      tempPtr->header.ppForm = topDisjunct->header.ppForm;
     }

   /*===============================================*/
   /* Rule completely parsed. Add to list of rules. */
   /*===============================================*/

   AddToDefruleList(topDisjunct);

   /*========================================================================*/
   /* If a rule is redefined, then we want to restore its breakpoint status. */
   /*========================================================================*/

#if DEBUGGING_FUNCTIONS
   if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,0))
     { EnvSetBreak(theEnv,topDisjunct); }
   if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,1) || EnvGetWatchItem(theEnv,"activations"))
     { EnvSetDefruleWatchActivations(theEnv,ON,(void *) topDisjunct); }
   if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,2) || EnvGetWatchItem(theEnv,"rules"))
     { EnvSetDefruleWatchFirings(theEnv,ON,(void *) topDisjunct); }
#endif

   /*================================*/
   /* Perform the incremental reset. */
   /*================================*/

   IncrementalReset(theEnv,topDisjunct);

   /*=============================================*/
   /* Return FALSE to indicate no errors occured. */
   /*=============================================*/

#endif
   return(FALSE);
  }