Ejemplo n.º 1
0
/***************************************************
  NAME         : ReplaceClassNameWithReference
  DESCRIPTION  : In parsing a make instance call,
                 this function replaces a constant
                 class name with an actual pointer
                 to the class
  INPUTS       : The expression
  RETURNS      : TRUE if all OK, FALSE
                 if class cannot be found
  SIDE EFFECTS : The expression type and value are
                 modified if class is found
  NOTES        : Searches current nd imported
                 modules for reference
 ***************************************************/
static intBool ReplaceClassNameWithReference(
  void *theEnv,
  EXPRESSION *theExp)
  {
   char *theClassName;
   void *theDefclass;

   if (theExp->type == SYMBOL)
     {
      theClassName = ValueToString(theExp->value);
      theDefclass = (void *) LookupDefclassInScope(theEnv,theClassName);
      if (theDefclass == NULL)
        {
         CantFindItemErrorMessage(theEnv,(char*)"class",theClassName);
         return(FALSE);
        }
      if (EnvClassAbstractP(theEnv,theDefclass))
        {
         PrintErrorID(theEnv,(char*)"INSMNGR",3,FALSE);
         EnvPrintRouter(theEnv,WERROR,(char*)"Cannot create instances of abstract class ");
         EnvPrintRouter(theEnv,WERROR,theClassName);
         EnvPrintRouter(theEnv,WERROR,(char*)".\n");
         return(FALSE);
        }
      theExp->type = DEFCLASS_PTR;
      theExp->value = theDefclass;
     }
   return(TRUE);
  }
Ejemplo n.º 2
0
globle void RefreshCommand(
    void *theEnv)
{
    char *ruleName;
    void *rulePtr;

    /*===========================*/
    /* Get the name of the rule. */
    /*===========================*/

    ruleName = GetConstructName(theEnv,(char*)"refresh",(char*)"rule name");
    if (ruleName == NULL) return;

    /*===============================*/
    /* Determine if the rule exists. */
    /*===============================*/

    rulePtr = EnvFindDefrule(theEnv,ruleName);
    if (rulePtr == NULL)
    {
        CantFindItemErrorMessage(theEnv,(char*)"defrule",ruleName);
        return;
    }

    /*===================*/
    /* Refresh the rule. */
    /*===================*/

    EnvRefresh(theEnv,rulePtr);
}
Ejemplo n.º 3
0
/***************************************************
  NAME         : ReplaceTemplateNameWithReference
  DESCRIPTION  : In parsing an fact-set query,
                 this function replaces a constant
                 template name with an actual pointer
                 to the template
  INPUTS       : The expression
  RETURNS      : TRUE if all OK, FALSE
                 if template cannot be found
  SIDE EFFECTS : The expression type and value are
                 modified if template is found
  NOTES        : Searches current and imported
                 modules for reference
 ***************************************************/
static intBool ReplaceTemplateNameWithReference(
  void *theEnv,
  EXPRESSION *theExp)
  {
   const char *theTemplateName;
   void *theDeftemplate;
   int count;

   if (theExp->type == SYMBOL)
     {
      theTemplateName = ValueToString(theExp->value);
      
      theDeftemplate = (struct deftemplate *)
                       FindImportedConstruct(theEnv,"deftemplate",NULL,theTemplateName,
                                             &count,TRUE,NULL);

      if (theDeftemplate == NULL)
        {
         CantFindItemErrorMessage(theEnv,"deftemplate",theTemplateName);
         return(FALSE);
        }
        
      if (count > 1)
        {
         AmbiguousReferenceErrorMessage(theEnv,"deftemplate",theTemplateName);
         return(FALSE);
        }

      theExp->type = DEFTEMPLATE_PTR;
      theExp->value = theDeftemplate;
     }
   return(TRUE);
  }
Ejemplo n.º 4
0
/***************************************************
  NAME         : ReplaceClassNameWithReference
  DESCRIPTION  : In parsing a make instance call,
                 this function replaces a constant
                 class name with an actual pointer
                 to the class
  INPUTS       : The expression
  RETURNS      : TRUE if all OK, FALSE
                 if class cannot be found
  SIDE EFFECTS : The expression type and value are
                 modified if class is found
  NOTES        : Searches current nd imported
                 modules for reference
  CHANGES      : It's now possible to create an instance of a
                 class that's not in scope if the module name
                 is specified.
 ***************************************************/
static intBool ReplaceClassNameWithReference(
  void *theEnv,
  EXPRESSION *theExp)
  {
   const char *theClassName;
   void *theDefclass;

   if (theExp->type == SYMBOL)
     {
      theClassName = ValueToString(theExp->value);
      //theDefclass = (void *) LookupDefclassInScope(theEnv,theClassName);
      theDefclass = (void *) LookupDefclassByMdlOrScope(theEnv,theClassName); // Module or scope is now allowed
      if (theDefclass == NULL)
        {
         CantFindItemErrorMessage(theEnv,"class",theClassName);
         return(FALSE);
        }
      if (EnvClassAbstractP(theEnv,theDefclass))
        {
         PrintErrorID(theEnv,"INSMNGR",3,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Cannot create instances of abstract class ");
         EnvPrintRouter(theEnv,WERROR,theClassName);
         EnvPrintRouter(theEnv,WERROR,".\n");
         return(FALSE);
        }
      theExp->type = DEFCLASS_PTR;
      theExp->value = theDefclass;
      
#if (! RUN_TIME) && (! BLOAD_ONLY)
      if (! ConstructData(theEnv)->ParsingConstruct)
        { ConstructData(theEnv)->DanglingConstructs++; }
#endif
     }
   return(TRUE);
  }
Ejemplo n.º 5
0
globle void RemoveBreakCommand(
  void *theEnv)
  {
   DATA_OBJECT argPtr;
   char *argument;
   int nargs;
   void *defrulePtr;

   if ((nargs = EnvArgCountCheck(theEnv,"remove-break",NO_MORE_THAN,1)) == -1)
     { return; }

   if (nargs == 0)
     {
      RemoveAllBreakpoints(theEnv);
      return;
     }

   if (EnvArgTypeCheck(theEnv,"remove-break",1,SYMBOL,&argPtr) == FALSE) return;

   argument = DOToString(argPtr);

   if ((defrulePtr = EnvFindDefrule(theEnv,argument)) == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defrule",argument);
      return;
     }

   if (EnvRemoveBreak(theEnv,defrulePtr) == FALSE)
     {
      EnvPrintRouter(theEnv,WERROR,"Rule ");
      EnvPrintRouter(theEnv,WERROR,argument);
      EnvPrintRouter(theEnv,WERROR," does not have a breakpoint set.\n");
     }
  }
Ejemplo n.º 6
0
/***************************************************
  NAME         : ReplaceClassNameWithReference
  DESCRIPTION  : In parsing a make instance call,
                 this function replaces a constant
                 class name with an actual pointer
                 to the class
  INPUTS       : The expression
  RETURNS      : TRUE if all OK, FALSE
                 if class cannot be found
  SIDE EFFECTS : The expression type and value are
                 modified if class is found
  NOTES        : Searches current nd imported
                 modules for reference
 ***************************************************/
static BOOLEAN ReplaceClassNameWithReference(
  EXPRESSION *exp)
  {
   char *theClassName;
   void *theDefclass;

   if (exp->type == SYMBOL)
     {
      theClassName = ValueToString(exp->value);
      theDefclass = (void *) LookupDefclassInScope(theClassName);
      if (theDefclass == NULL)
        {
         CantFindItemErrorMessage("class",theClassName);
         return(FALSE);
        }
      if (ClassAbstractP(theDefclass))
        {
         PrintErrorID("INSMNGR",3,FALSE);
         PrintRouter(WERROR,"Cannot create instances of abstract class ");
         PrintRouter(WERROR,theClassName);
         PrintRouter(WERROR,".\n");
         return(FALSE);
        }
      exp->type = DEFCLASS_PTR;
      exp->value = theDefclass;
     }
   return(TRUE);
  }
Ejemplo n.º 7
0
void SetCurrentModuleCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue theArg;
   const char *argument;
   Defmodule *theModule;
   CLIPSLexeme *oldModuleName;

   /*=======================*/
   /* Set the return value. */
   /*=======================*/

   theModule = GetCurrentModule(theEnv);
   if (theModule == NULL)
     {
      returnValue->lexemeValue = FalseSymbol(theEnv);
      return;
     }

   oldModuleName = theModule->header.name;
   returnValue->value = oldModuleName;

   /*=====================================================*/
   /* Check for the correct number and type of arguments. */
   /*=====================================================*/

   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
     { return; }

   argument = theArg.lexemeValue->contents;

   /*================================================*/
   /* Set the current module to the specified value. */
   /*================================================*/

   theModule = FindDefmodule(theEnv,argument);

   if (theModule == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",argument,true);
      return;
     }

   SetCurrentModule(theEnv,theModule);
  }
Ejemplo n.º 8
0
globle void *SetCurrentModuleCommand(
  void *theEnv)
  {
   DATA_OBJECT argPtr;
   char *argument;
   struct defmodule *theModule;
   SYMBOL_HN *defaultReturn;

   /*=====================================================*/
   /* Check for the correct number and type of arguments. */
   /*=====================================================*/

   theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
   if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));

   defaultReturn = (SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(((struct defmodule *) EnvGetCurrentModule(theEnv))->name));

   if (EnvArgCountCheck(theEnv,"set-current-module",EXACTLY,1) == -1)
     { return(defaultReturn); }

   if (EnvArgTypeCheck(theEnv,"set-current-module",1,SYMBOL,&argPtr) == FALSE)
     { return(defaultReturn); }

   argument = DOToString(argPtr);

   /*================================================*/
   /* Set the current module to the specified value. */
   /*================================================*/

   theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument);

   if (theModule == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",argument);
      return(defaultReturn);
     }

   EnvSetCurrentModule(theEnv,(void *) theModule);

   /*================================*/
   /* Return the new current module. */
   /*================================*/

   return((SYMBOL_HN *) defaultReturn);
  }
Ejemplo n.º 9
0
globle long long JoinActivityCommand(
  void *theEnv)
  {
   char *ruleName;
   void *rulePtr;

   ruleName = GetConstructName(theEnv,"join-activity","rule name");
   if (ruleName == NULL) return(0);

   rulePtr = EnvFindDefrule(theEnv,ruleName);
   if (rulePtr == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defrule",ruleName);
      return(0);
     }

   return EnvJoinActivity(theEnv,rulePtr,0);
  }
Ejemplo n.º 10
0
globle int PPDefmodule(
  void *theEnv,
  char *defmoduleName,
  char *logicalName)
  {
   void *defmodulePtr;

   defmodulePtr = EnvFindDefmodule(theEnv,defmoduleName);
   if (defmodulePtr == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",defmoduleName);
      return(FALSE);
     }

   if (EnvGetDefmodulePPForm(theEnv,defmodulePtr) == NULL) return(TRUE);
   PrintInChunks(theEnv,logicalName,EnvGetDefmodulePPForm(theEnv,defmodulePtr));
   return(TRUE);
  }
Ejemplo n.º 11
0
bool PPDefmodule(
  void *theEnv,
  const char *defmoduleName,
  const char *logicalName)
  {
   void *defmodulePtr;

   defmodulePtr = EnvFindDefmodule(theEnv,defmoduleName);
   if (defmodulePtr == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",defmoduleName);
      return(false);
     }

   if (EnvGetDefmodulePPForm(theEnv,defmodulePtr) == NULL) return(true);
   PrintInChunks(theEnv,logicalName,EnvGetDefmodulePPForm(theEnv,defmodulePtr));
   return(true);
  }
Ejemplo n.º 12
0
globle long RuleComplexityCommand(
  void *theEnv)
  {
   char *ruleName;
   struct defrule *rulePtr;

   ruleName = GetConstructName(theEnv,"rule-complexity","rule name");
   if (ruleName == NULL) return(-1);

   rulePtr = (struct defrule *) EnvFindDefrule(theEnv,ruleName);
   if (rulePtr == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defrule",ruleName);
      return(-1);
     }

   return(rulePtr->complexity);
  }
Ejemplo n.º 13
0
globle void MatchesCountCommand(
  void *theEnv)
  {
   char *ruleName;
   void *rulePtr;

   ruleName = GetConstructName(theEnv,"matches-count","rule name");
   if (ruleName == NULL) return;

   rulePtr = EnvFindDefrule(theEnv,ruleName);
   if (rulePtr == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defrule",ruleName);
      return;
     }

   EnvMatchesCount(theEnv,rulePtr);
  }
Ejemplo n.º 14
0
/********************************************************************
  NAME         : GetFunctionRestrictions
  DESCRIPTION  : Gets DefineFunction2() restriction list for function
  INPUTS       : None
  RETURNS      : A string containing the function restriction codes
  SIDE EFFECTS : EvaluationError set on errors
  NOTES        : None
 ********************************************************************/
globle void *GetFunctionRestrictions(
    void *theEnv)
{
    DATA_OBJECT temp;
    struct FunctionDefinition *fptr;

    if (EnvArgTypeCheck(theEnv,"get-function-restrictions",1,SYMBOL,&temp) == FALSE)
        return((SYMBOL_HN *) EnvAddSymbol(theEnv,""));
    fptr = FindFunction(theEnv,DOToString(temp));
    if (fptr == NULL)
    {
        CantFindItemErrorMessage(theEnv,"function",DOToString(temp));
        SetEvaluationError(theEnv,TRUE);
        return((SYMBOL_HN *) EnvAddSymbol(theEnv,""));
    }
    if (fptr->restrictions == NULL)
        return((SYMBOL_HN *) EnvAddSymbol(theEnv,"0**"));
    return((SYMBOL_HN *) EnvAddSymbol(theEnv,fptr->restrictions));
}
Ejemplo n.º 15
0
globle int FocusCommand(
  void *theEnv)
  {
   DATA_OBJECT argPtr;
   char *argument;
   struct defmodule *theModule;
   int argCount, i;

   /*=====================================================*/
   /* Check for the correct number and type of arguments. */
   /*=====================================================*/

   if ((argCount = EnvArgCountCheck(theEnv,"focus",AT_LEAST,1)) == -1)
     { return(FALSE); }

   /*===========================================*/
   /* Focus on the specified defrule module(s). */
   /*===========================================*/

   for (i = argCount; i > 0; i--)
     {
      if (EnvArgTypeCheck(theEnv,"focus",i,SYMBOL,&argPtr) == FALSE)
        { return(FALSE); }

      argument = DOToString(argPtr);
      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument);

      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,"defmodule",argument);
         return(FALSE);
        }

      EnvFocus(theEnv,(void *) theModule);
     }

   /*===================================================*/
   /* Return TRUE to indicate success of focus command. */
   /*===================================================*/

   return(TRUE);
  }
Ejemplo n.º 16
0
globle void ShowJoinsCommand(
  void *theEnv)
  {
   char *ruleName;
   void *rulePtr;

   ruleName = GetConstructName(theEnv,"show-joins","rule name");
   if (ruleName == NULL) return;

   rulePtr = EnvFindDefrule(theEnv,ruleName);
   if (rulePtr == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defrule",ruleName);
      return;
     }

   ShowJoins(theEnv,rulePtr);

   return;
  }
Ejemplo n.º 17
0
globle struct fact *GetFactAddressOrIndexArgument(
  void *theEnv,
  const char *theFunction,
  int position,
  int noFactError)
  {
   DATA_OBJECT item;
   long long factIndex;
   struct fact *theFact;
   char tempBuffer[20];

   EnvRtnUnknown(theEnv,position,&item);

   if (GetType(item) == FACT_ADDRESS)
     {
      if (((struct fact *) GetValue(item))->garbage) return(NULL);
      else return (((struct fact *) GetValue(item)));
     }
   else if (GetType(item) == INTEGER)
     {
      factIndex = ValueToLong(item.value);
      if (factIndex < 0)
        {
         ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index");
         return(NULL);
        }

      theFact = FindIndexedFact(theEnv,factIndex);
      if ((theFact == NULL) && noFactError)
        {
         gensprintf(tempBuffer,"f-%lld",factIndex);
         CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
         return(NULL);
        }

      return(theFact);
     }

   ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index");
   return(NULL);
  }
Ejemplo n.º 18
0
/***************************************************
  NAME         : ReplaceClassNameWithReference
  DESCRIPTION  : In parsing an instance-set query,
                 this function replaces a constant
                 class name with an actual pointer
                 to the class
  INPUTS       : The expression
  RETURNS      : TRUE if all OK, FALSE
                 if class cannot be found
  SIDE EFFECTS : The expression type and value are
                 modified if class is found
  NOTES        : Searches current and imported
                 modules for reference
 ***************************************************/
static BOOLEAN ReplaceClassNameWithReference(
  void *theEnv,
  EXPRESSION *theExp)
  {
   char *theClassName;
   void *theDefclass;

   if (theExp->type == SYMBOL)
     {
      theClassName = ValueToString(theExp->value);
      theDefclass = (void *) LookupDefclassByMdlOrScope(theEnv,theClassName);
      if (theDefclass == NULL)
        {
         CantFindItemErrorMessage(theEnv,"class",theClassName);
         return(FALSE);
        }
      theExp->type = DEFCLASS_PTR;
      theExp->value = theDefclass;
     }
   return(TRUE);
  }
Ejemplo n.º 19
0
globle void SetBreakCommand(
  void *theEnv)
  {
   DATA_OBJECT argPtr;
   char *argument;
   void *defrulePtr;

   if (EnvArgCountCheck(theEnv,"set-break",EXACTLY,1) == -1) return;

   if (EnvArgTypeCheck(theEnv,"set-break",1,SYMBOL,&argPtr) == FALSE) return;

   argument = DOToString(argPtr);

   if ((defrulePtr = EnvFindDefrule(theEnv,argument)) == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defrule",argument);
      return;
     }

   EnvSetBreak(theEnv,defrulePtr);
  }
Ejemplo n.º 20
0
/***************************************************
  NAME         : ReplaceTemplateNameWithReference
  DESCRIPTION  : In parsing an fact-set query,
                 this function replaces a constant
                 template name with an actual pointer
                 to the template
  INPUTS       : The expression
  RETURNS      : TRUE if all OK, FALSE
                 if template cannot be found
  SIDE EFFECTS : The expression type and value are
                 modified if template is found
  NOTES        : Searches current and imported
                 modules for reference
 ***************************************************/
static intBool ReplaceTemplateNameWithReference(
  void *theEnv,
  EXPRESSION *theExp)
  {
   const char *theTemplateName;
   void *theDeftemplate;
   int count;

   if (theExp->type == SYMBOL)
     {
      theTemplateName = ValueToString(theExp->value);
      
      theDeftemplate = (struct deftemplate *)
                       FindImportedConstruct(theEnv,"deftemplate",NULL,theTemplateName,
                                             &count,TRUE,NULL);

      if (theDeftemplate == NULL)
        {
         CantFindItemErrorMessage(theEnv,"deftemplate",theTemplateName);
         return(FALSE);
        }
        
      if (count > 1)
        {
         AmbiguousReferenceErrorMessage(theEnv,"deftemplate",theTemplateName);
         return(FALSE);
        }

      theExp->type = DEFTEMPLATE_PTR;
      theExp->value = theDeftemplate;
      
#if (! RUN_TIME) && (! BLOAD_ONLY)
      if (! ConstructData(theEnv)->ParsingConstruct)
        { ConstructData(theEnv)->DanglingConstructs++; }
#endif
     }

   return(TRUE);
  }
Ejemplo n.º 21
0
void *GetFactOrInstanceArgument(
  UDFContext *context,
  unsigned int thePosition,
  UDFValue *item)
  {
   Environment *theEnv = context->environment;
#if DEFTEMPLATE_CONSTRUCT || OBJECT_SYSTEM
   void *ptr;
#endif

   /*==============================*/
   /* Retrieve the first argument. */
   /*==============================*/

   UDFNthArgument(context,thePosition,ANY_TYPE_BITS,item);

   /*==================================================*/
   /* Fact and instance addresses are valid arguments. */
   /*==================================================*/

   if (CVIsType(item,FACT_ADDRESS_BIT))
     {
      if (item->factValue->garbage)
        {
         FactRetractedErrorMessage(theEnv,item->factValue);
         return NULL;
        }
        
      return item->value;
     }

   else if (CVIsType(item,INSTANCE_ADDRESS_BIT))
     {
      if (item->instanceValue->garbage)
        {
         CantFindItemErrorMessage(theEnv,"instance",item->instanceValue->name->contents,false);
         return NULL;
        }
        
      return item->value;
     }

   /*==================================================*/
   /* An integer is a valid argument if it corresponds */
   /* to the fact index of an existing fact.           */
   /*==================================================*/

#if DEFTEMPLATE_CONSTRUCT
   else if (item->header->type == INTEGER_TYPE)
     {
      if ((ptr = (void *) FindIndexedFact(theEnv,item->integerValue->contents)) == NULL)
        {
         char tempBuffer[20];
         gensprintf(tempBuffer,"f-%lld",item->integerValue->contents);
         CantFindItemErrorMessage(theEnv,"fact",tempBuffer,false);
        }
      return ptr;
     }
#endif

   /*================================================*/
   /* Instance names and symbols are valid arguments */
   /* if they correspond to an existing instance.    */
   /*================================================*/

#if OBJECT_SYSTEM
   else if (CVIsType(item,INSTANCE_NAME_BIT | SYMBOL_BIT))
     {
      if ((ptr = (void *) FindInstanceBySymbol(theEnv,item->lexemeValue)) == NULL)
        {
         CantFindItemErrorMessage(theEnv,"instance",item->lexemeValue->contents,false);
        }
      return ptr;
     }
#endif

   /*========================================*/
   /* Any other type is an invalid argument. */
   /*========================================*/

   ExpectedTypeError2(theEnv,UDFContextFunctionName(context),thePosition);
   return NULL;
  }
Ejemplo n.º 22
0
globle void FactsCommand(
  void *theEnv)
  {
   int argumentCount;
   long long start = UNSPECIFIED, end = UNSPECIFIED, max = UNSPECIFIED;
   struct defmodule *theModule;
   DATA_OBJECT theValue;
   int argOffset;

   /*=========================================================*/
   /* Determine the number of arguments to the facts command. */
   /*=========================================================*/

   if ((argumentCount = EnvArgCountCheck(theEnv,(char*)"facts",NO_MORE_THAN,4)) == -1) return;

   /*==================================*/
   /* The default module for the facts */
   /* command is the current module.   */
   /*==================================*/

   theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));

   /*==========================================*/
   /* If no arguments were specified, then use */
   /* the default values to list the facts.    */
   /*==========================================*/

   if (argumentCount == 0)
     {
      EnvFacts(theEnv,WDISPLAY,theModule,start,end,max);
      return;
     }

   /*========================================================*/
   /* Since there are one or more arguments, see if a module */
   /* or start index was specified as the first argument.    */
   /*========================================================*/

   EnvRtnUnknown(theEnv,1,&theValue);

   /*===============================================*/
   /* If the first argument is a symbol, then check */
   /* to see that a valid module was specified.     */
   /*===============================================*/

   if (theValue.type == SYMBOL)
     {
      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theValue.value));
      if ((theModule == NULL) && (strcmp(ValueToString(theValue.value),"*") != 0))
        {
         SetEvaluationError(theEnv,TRUE);
         CantFindItemErrorMessage(theEnv,(char*)"defmodule",ValueToString(theValue.value));
         return;
        }

      if ((start = GetFactsArgument(theEnv,2,argumentCount)) == INVALID) return;

      argOffset = 1;
     }

   /*================================================*/
   /* Otherwise if the first argument is an integer, */
   /* check to see that a valid index was specified. */
   /*================================================*/

   else if (theValue.type == INTEGER)
     {
      start = DOToLong(theValue);
      if (start < 0)
        {
         ExpectedTypeError1(theEnv,(char*)"facts",1,(char*)"symbol or positive number");
         SetHaltExecution(theEnv,TRUE);
         SetEvaluationError(theEnv,TRUE);
         return;
        }
      argOffset = 0;
     }

   /*==========================================*/
   /* Otherwise the first argument is invalid. */
   /*==========================================*/

   else
     {
      ExpectedTypeError1(theEnv,(char*)"facts",1,(char*)"symbol or positive number");
      SetHaltExecution(theEnv,TRUE);
      SetEvaluationError(theEnv,TRUE);
      return;
     }

   /*==========================*/
   /* Get the other arguments. */
   /*==========================*/

   if ((end = GetFactsArgument(theEnv,2 + argOffset,argumentCount)) == INVALID) return;
   if ((max = GetFactsArgument(theEnv,3 + argOffset,argumentCount)) == INVALID) return;

   /*=================*/
   /* List the facts. */
   /*=================*/

   EnvFacts(theEnv,WDISPLAY,theModule,start,end,max);
  }
Ejemplo n.º 23
0
globle void RetractCommand(
  void *theEnv)
  {
   long long factIndex;
   struct fact *ptr;
   struct expr *theArgument;
   DATA_OBJECT theResult;
   int argNumber;

   /*================================*/
   /* Iterate through each argument. */
   /*================================*/

   for (theArgument = GetFirstArgument(), argNumber = 1;
        theArgument != NULL;
        theArgument = GetNextArgument(theArgument), argNumber++)
     {
      /*========================*/
      /* Evaluate the argument. */
      /*========================*/

      EvaluateExpression(theEnv,theArgument,&theResult);

      /*===============================================*/
      /* If the argument evaluates to an integer, then */
      /* it's assumed to be the fact index of the fact */
      /* to be retracted.                              */
      /*===============================================*/

      if (theResult.type == INTEGER)
        {
         /*==========================================*/
         /* A fact index must be a positive integer. */
         /*==========================================*/

         factIndex = ValueToLong(theResult.value);
         if (factIndex < 0)
           {
            ExpectedTypeError1(theEnv,(char*)"retract",argNumber,(char*)"fact-address, fact-index, or the symbol *");
            return;
           }

         /*================================================*/
         /* See if a fact with the specified index exists. */
         /*================================================*/

         ptr = FindIndexedFact(theEnv,factIndex);

         /*=====================================*/
         /* If the fact exists then retract it, */
         /* otherwise print an error message.   */
         /*=====================================*/

         if (ptr != NULL)
           { EnvRetract(theEnv,(void *) ptr); }
         else
           {
            char tempBuffer[20];
            gensprintf(tempBuffer,"f-%lld",factIndex);
            CantFindItemErrorMessage(theEnv,(char*)"fact",tempBuffer);
           }
        }

      /*===============================================*/
      /* Otherwise if the argument evaluates to a fact */
      /* address, we can directly retract it.          */
      /*===============================================*/

      else if (theResult.type == FACT_ADDRESS)
        { EnvRetract(theEnv,theResult.value); }

      /*============================================*/
      /* Otherwise if the argument evaluates to the */
      /* symbol *, then all facts are retracted.    */
      /*============================================*/

      else if ((theResult.type == SYMBOL) ?
               (strcmp(ValueToString(theResult.value),"*") == 0) : FALSE)
        {
         RemoveAllFacts(theEnv);
         return;
        }

      /*============================================*/
      /* Otherwise the argument has evaluated to an */
      /* illegal value for the retract command.     */
      /*============================================*/

      else
        {
         ExpectedTypeError1(theEnv,(char*)"retract",argNumber,(char*)"fact-address, fact-index, or the symbol *");
         SetEvaluationError(theEnv,TRUE);
        }
     }
  }
Ejemplo n.º 24
0
globle SYMBOL_HN *GetConstructNameAndComment(
  void *theEnv,
  char *readSource,
  struct token *inputToken,
  char *constructName,
  void *(*findFunction)(void *,char *),
  int (*deleteFunction)(void *,void *),
  char *constructSymbol,
  int fullMessageCR,
  int getComment,
  int moduleNameAllowed)
  {
#if (MAC_MCW || WIN_MCW || MAC_XCD) && (! DEBUGGING_FUNCTIONS)
#pragma unused(fullMessageCR)
#endif
   SYMBOL_HN *name, *moduleName;
   int redefining = FALSE;
   void *theConstruct;
   unsigned separatorPosition;
   struct defmodule *theModule;

   /*==========================*/
   /* Next token should be the */
   /* name of the construct.   */
   /*==========================*/

   GetToken(theEnv,readSource,inputToken);
   if (inputToken->type != SYMBOL)
     {
      PrintErrorID(theEnv,"CSTRCPSR",2,TRUE);
      EnvPrintRouter(theEnv,WERROR,"Missing name for ");
      EnvPrintRouter(theEnv,WERROR,constructName);
      EnvPrintRouter(theEnv,WERROR," construct\n");
      return(NULL);
     }

   name = (SYMBOL_HN *) inputToken->value;

   /*===============================*/
   /* Determine the current module. */
   /*===============================*/

   separatorPosition = FindModuleSeparator(ValueToString(name));
   if (separatorPosition)
     {
      if (moduleNameAllowed == FALSE)
        {
         SyntaxErrorMessage(theEnv,"module specifier");
         return(NULL);
        }

      moduleName = ExtractModuleName(theEnv,separatorPosition,ValueToString(name));
      if (moduleName == NULL)
        {
         SyntaxErrorMessage(theEnv,"construct name");
         return(NULL);
        }

      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName));
      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(moduleName));
         return(NULL);
        }

      EnvSetCurrentModule(theEnv,(void *) theModule);
      name = ExtractConstructName(theEnv,separatorPosition,ValueToString(name));
      if (name == NULL)
        {
         SyntaxErrorMessage(theEnv,"construct name");
         return(NULL);
        }
     }

   /*=====================================================*/
   /* If the module was not specified, record the current */
   /* module name as part of the pretty-print form.       */
   /*=====================================================*/

   else
     {
      theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
      if (moduleNameAllowed)
        {
         PPBackup(theEnv);
         SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,theModule));
         SavePPBuffer(theEnv,"::");
         SavePPBuffer(theEnv,ValueToString(name));
        }
     }

   /*==================================================================*/
   /* Check for import/export conflicts from the construct definition. */
   /*==================================================================*/

#if DEFMODULE_CONSTRUCT
   if (FindImportExportConflict(theEnv,constructName,theModule,ValueToString(name)))
     {
      ImportExportConflictMessage(theEnv,constructName,ValueToString(name),NULL,NULL);
      return(NULL);
     }
#endif

   /*========================================================*/
   /* Remove the construct if it is already in the knowledge */
   /* base and we're not just checking syntax.               */
   /*========================================================*/

   if ((findFunction != NULL) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      theConstruct = (*findFunction)(theEnv,ValueToString(name));
      if (theConstruct != NULL)
        {
         redefining = TRUE;
         if (deleteFunction != NULL)
           {
            if ((*deleteFunction)(theEnv,theConstruct) == FALSE)
              {
               PrintErrorID(theEnv,"CSTRCPSR",4,TRUE);
               EnvPrintRouter(theEnv,WERROR,"Cannot redefine ");
               EnvPrintRouter(theEnv,WERROR,constructName);
               EnvPrintRouter(theEnv,WERROR," ");
               EnvPrintRouter(theEnv,WERROR,ValueToString(name));
               EnvPrintRouter(theEnv,WERROR," while it is in use.\n");
               return(NULL);
              }
           }
        }
     }

   /*=============================================*/
   /* If compilations are being watched, indicate */
   /* that a construct is being compiled.         */
   /*=============================================*/

#if DEBUGGING_FUNCTIONS
   if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) &&
       GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      if (redefining) 
        {
         PrintWarningID(theEnv,"CSTRCPSR",1,TRUE);
         EnvPrintRouter(theEnv,WDIALOG,"Redefining ");
        }
      else EnvPrintRouter(theEnv,WDIALOG,"Defining ");

      EnvPrintRouter(theEnv,WDIALOG,constructName);
      EnvPrintRouter(theEnv,WDIALOG,": ");
      EnvPrintRouter(theEnv,WDIALOG,ValueToString(name));

      if (fullMessageCR) EnvPrintRouter(theEnv,WDIALOG,"\n");
      else EnvPrintRouter(theEnv,WDIALOG," ");
     }
   else
#endif
     {
      if (GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
        { EnvPrintRouter(theEnv,WDIALOG,constructSymbol); }
     }

   /*===============================*/
   /* Get the comment if it exists. */
   /*===============================*/

   GetToken(theEnv,readSource,inputToken);
   if ((inputToken->type == STRING) && getComment)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,inputToken->printForm);
      GetToken(theEnv,readSource,inputToken);
      if (inputToken->type != RPAREN)
        {
         PPBackup(theEnv);
         SavePPBuffer(theEnv,"\n   ");
         SavePPBuffer(theEnv,inputToken->printForm);
        }
     }
   else if (inputToken->type != RPAREN)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv,"\n   ");
      SavePPBuffer(theEnv,inputToken->printForm);
     }

   /*===================================*/
   /* Return the name of the construct. */
   /*===================================*/

   return(name);
  }
Ejemplo n.º 25
0
static void DuplicateModifyCommand(
  void *theEnv,
  int retractIt,
  DATA_OBJECT_PTR returnValue)
  {
   long int factNum;
   struct fact *oldFact, *newFact, *theFact;
   struct expr *testPtr;
   DATA_OBJECT computeResult;
   struct deftemplate *templatePtr;
   struct templateSlot *slotPtr;
   int i, position, found;

   /*===================================================*/
   /* Set the default return value to the symbol FALSE. */
   /*===================================================*/

   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,SymbolData(theEnv)->FalseSymbol);

   /*==================================================*/
   /* Evaluate the first argument which is used to get */
   /* a pointer to the fact to be modified/duplicated. */
   /*==================================================*/

   testPtr = GetFirstArgument();
   EvaluateExpression(theEnv,testPtr,&computeResult);

   /*==============================================================*/
   /* If an integer is supplied, then treat it as a fact-index and */
   /* search the fact-list for the fact with that fact-index.      */
   /*==============================================================*/

   if (computeResult.type == INTEGER)
     {
      factNum = ValueToLong(computeResult.value);
      if (factNum < 0)
        {
         if (retractIt) ExpectedTypeError2(theEnv,"modify",1);
         else ExpectedTypeError2(theEnv,"duplicate",1);
         SetEvaluationError(theEnv,TRUE);
         return;
        }

      oldFact = (struct fact *) EnvGetNextFact(theEnv,NULL);
      while (oldFact != NULL)
        {
         if (oldFact->factIndex == factNum)
           { break; }
         else
           { oldFact = oldFact->nextFact; }
        }

      if (oldFact == NULL)
        {
         char tempBuffer[20];
         sprintf(tempBuffer,"f-%ld",factNum);
         CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
         return;
        }
     }

   /*==========================================*/
   /* Otherwise, if a pointer is supplied then */
   /* no lookup is required.                   */
   /*==========================================*/

   else if (computeResult.type == FACT_ADDRESS)
     { oldFact = (struct fact *) computeResult.value; }

   /*===========================================*/
   /* Otherwise, the first argument is invalid. */
   /*===========================================*/

   else
     {
      if (retractIt) ExpectedTypeError2(theEnv,"modify",1);
      else ExpectedTypeError2(theEnv,"duplicate",1);
      SetEvaluationError(theEnv,TRUE);
      return;
     }

   /*==================================*/
   /* See if it is a deftemplate fact. */
   /*==================================*/

   templatePtr = oldFact->whichDeftemplate;

   if (templatePtr->implied) return;

   /*================================================================*/
   /* Duplicate the values from the old fact (skipping multifields). */
   /*================================================================*/

   newFact = (struct fact *) CreateFactBySize(theEnv,oldFact->theProposition.multifieldLength);
   newFact->whichDeftemplate = templatePtr;
   for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++)
     {
      newFact->theProposition.theFields[i].type = oldFact->theProposition.theFields[i].type;
      if (newFact->theProposition.theFields[i].type != MULTIFIELD)
        { newFact->theProposition.theFields[i].value = oldFact->theProposition.theFields[i].value; }
      else
        { newFact->theProposition.theFields[i].value = NULL; }
     }

   /*========================*/
   /* Start replacing slots. */
   /*========================*/

   testPtr = testPtr->nextArg;
   while (testPtr != NULL)
     {
      /*============================================================*/
      /* If the slot identifier is an integer, then the slot was    */
      /* previously identified and its position within the template */
      /* was stored. Otherwise, the position of the slot within the */
      /* deftemplate has to be determined by comparing the name of  */
      /* the slot against the list of slots for the deftemplate.    */
      /*============================================================*/

      if (testPtr->type == INTEGER)
        { position = (int) ValueToLong(testPtr->value); }
      else
        {
         found = FALSE;
         position = 0;
         slotPtr = templatePtr->slotList;
         while (slotPtr != NULL)
           {
            if (slotPtr->slotName == (SYMBOL_HN *) testPtr->value)
              {
               found = TRUE;
               slotPtr = NULL;
              }
            else
              {
               slotPtr = slotPtr->next;
               position++;
              }
           }

         if (! found)
           {
            InvalidDeftemplateSlotMessage(theEnv,ValueToString(testPtr->value),
                                          ValueToString(templatePtr->header.name));
            SetEvaluationError(theEnv,TRUE);
            ReturnFact(theEnv,newFact);
            return;
           }
        }

      /*===================================================*/
      /* If a single field slot is being replaced, then... */
      /*===================================================*/

      if (newFact->theProposition.theFields[position].type != MULTIFIELD)
        {
         /*======================================================*/
         /* If the list of values to store in the slot is empty  */
         /* or contains more than one member than an error has   */
         /* occured because a single field slot can only contain */
         /* a single value.                                      */
         /*======================================================*/

         if ((testPtr->argList == NULL) ? TRUE : (testPtr->argList->nextArg != NULL))
           {
            MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr);
            ReturnFact(theEnv,newFact);
            return;
           }

         /*===================================================*/
         /* Evaluate the expression to be stored in the slot. */
         /*===================================================*/

         EvaluateExpression(theEnv,testPtr->argList,&computeResult);
         SetEvaluationError(theEnv,FALSE);

         /*====================================================*/
         /* If the expression evaluated to a multifield value, */
         /* then an error occured since a multifield value can */
         /* not be stored in a single field slot.              */
         /*====================================================*/

         if (computeResult.type == MULTIFIELD)
           {
            ReturnFact(theEnv,newFact);
            MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr);
            return;
           }

         /*=============================*/
         /* Store the value in the slot */
         /*=============================*/

         newFact->theProposition.theFields[position].type =
            computeResult.type;
         newFact->theProposition.theFields[position].value =
            computeResult.value;
        }

      /*=================================*/
      /* Else replace a multifield slot. */
      /*=================================*/

      else
        {
         /*======================================*/
         /* Determine the new value of the slot. */
         /*======================================*/

         StoreInMultifield(theEnv,&computeResult,testPtr->argList,FALSE);
         SetEvaluationError(theEnv,FALSE);

         /*=============================*/
         /* Store the value in the slot */
         /*=============================*/

         newFact->theProposition.theFields[position].type =
            computeResult.type;
         newFact->theProposition.theFields[position].value =
            computeResult.value;
        }

      testPtr = testPtr->nextArg;
     }

   /*=====================================*/
   /* Copy the multifield values from the */
   /* old fact that were not replaced.    */
   /*=====================================*/

   for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++)
     {
      if ((newFact->theProposition.theFields[i].type == MULTIFIELD) &&
          (newFact->theProposition.theFields[i].value == NULL))

        {
         newFact->theProposition.theFields[i].value =
            CopyMultifield(theEnv,(struct multifield *) oldFact->theProposition.theFields[i].value);
        }
     }

   /*======================================*/
   /* Perform the duplicate/modify action. */
   /*======================================*/

   if (retractIt) EnvRetract(theEnv,oldFact);
   theFact = (struct fact *) EnvAssert(theEnv,newFact);

   /*========================================*/
   /* The asserted fact is the return value. */
   /*========================================*/

   if (theFact != NULL)
     {
      SetpDOBegin(returnValue,1);
      SetpDOEnd(returnValue,theFact->theProposition.multifieldLength);
      SetpType(returnValue,FACT_ADDRESS);
      SetpValue(returnValue,(void *) theFact);
     }

   return;
  }
Ejemplo n.º 26
0
//madianyi End
globle void UpdateCommand(
  void *theEnv,
  DATA_OBJECT_PTR rv)
  {
   long long factIndex;
   struct fact *oldFact, *newFact, *theFact;
   struct defrule *ExecutingRule = NULL;
   
   struct expr *testPtr;
   DATA_OBJECT computeResult;


   /*===================================================*/
   /* Set the default return value to the symbol FALSE. */
   /*===================================================*/

   SetpType(rv,SYMBOL);
   SetpValue(rv,EnvFalseSymbol(theEnv));

   /*==================================================*/
   /* Evaluate the first argument which is used to get */
   /* a pointer to the fact to be updated. */
   /*==================================================*/

   testPtr = GetFirstArgument();
   EnvIncrementClearReadyLocks(theEnv);
   EvaluateExpression(theEnv,testPtr,&computeResult);
   EnvDecrementClearReadyLocks(theEnv);

   /*==============================================================*/
   /* If an integer is supplied, then treat it as a fact-index and */
   /* search the fact-list for the fact with that fact-index.      */
   /*==============================================================*/

   if (computeResult.type == INTEGER)
     {
      factIndex = ValueToLong(computeResult.value);
      if (factIndex < 0)
        {
         ExpectedTypeError1(theEnv,"update",1,"fact-address, fact-index, or the symbol *");
         return;
        }

      /*================================================*/
      /* See if a fact with the specified index exists. */
      /*================================================*/

      oldFact = FindIndexedFact(theEnv,factIndex);

      if (oldFact == NULL)
        {
         char tempBuffer[20];
         gensprintf(tempBuffer,"f-%lld",factIndex);
         CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
         return;
        }
     }
   /*==========================================*/
   /* Otherwise, if a pointer is supplied then */
   /* no lookup is required.                   */
   /*==========================================*/

   else if (computeResult.type == FACT_ADDRESS)
     { oldFact = (struct fact *) computeResult.value; }

   /*============================================*/
   /* Otherwise the argument has evaluated to an */
   /* illegal value for the retract command.     */
   /*============================================*/

   else
     {
      ExpectedTypeError1(theEnv,"update",1,"fact-address, fact-index, or the symbol *");
      SetEvaluationError(theEnv,TRUE);
     }

   /*============================================*/
   /* Retract oldFact and Assert newFact */
   /*============================================*/
   if (oldFact->localFact != NULL)
     {
      newFact = oldFact->localFact;
      //Remove oldFact from localFactList of ExecutingRule
      ExecutingRule = EngineData(theEnv)->ExecutingRule;

      if (oldFact == ExecutingRule->lastLocalFact)
       { ExecutingRule->lastLocalFact = oldFact->previousLocalFact; }

      if (oldFact->previousLocalFact == NULL)
       {
        ExecutingRule->localFactList = ExecutingRule->localFactList->nextLocalFact;
        if (ExecutingRule->localFactList != NULL)
          { ExecutingRule->localFactList->previousLocalFact = NULL; }
       }
      else
       {
        oldFact->previousLocalFact->nextLocalFact = oldFact->nextLocalFact;
        if (oldFact->nextLocalFact != NULL)
          { oldFact->nextLocalFact->previousLocalFact = oldFact->previousLocalFact; }
       }

	EnvRetract(theEnv,oldFact);

	theFact = (struct fact *) EnvAssert(theEnv,(void *) newFact);
       if (theFact != NULL)
        {
         SetpType(rv,FACT_ADDRESS);
         SetpValue(rv,(void *) theFact);
        }
       return;	
     }
   else
     {
      ExpectedTypeError1(theEnv,"update",1,"been set before *");
      SetEvaluationError(theEnv,TRUE);
     }
   
  }
Ejemplo n.º 27
0
globle intBool ParseDefglobal(
  void *theEnv,
  char *readSource)
  {
   int defglobalError = FALSE;
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,readSource)
#endif

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

   struct token theToken;
   int tokenRead = TRUE;
   struct defmodule *theModule;

   /*=====================================*/
   /* Pretty print buffer initialization. */
   /*=====================================*/

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defglobal ");

   /*=================================================*/
   /* Individual defglobal constructs can't be parsed */
   /* while a binary load is in effect.               */
   /*=================================================*/

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

   /*===========================*/
   /* Look for the module name. */
   /*===========================*/

   GetToken(theEnv,readSource,&theToken);
   if (theToken.type == SYMBOL)
     {
      /*=================================================*/
      /* The optional module name can't contain a module */
      /* separator like other constructs. For example,   */
      /* (defrule X::foo is OK for rules, but the right  */
      /* syntax for defglobals is (defglobal X ?*foo*.   */
      /*=================================================*/

      tokenRead = FALSE;
      if (FindModuleSeparator(ValueToString(theToken.value)))
        {
         SyntaxErrorMessage(theEnv,"defglobal");
         return(TRUE);
        }

      /*=================================*/
      /* Determine if the module exists. */
      /*=================================*/

      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken.value));
      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken.value));
         return(TRUE);
        }

      /*=========================================*/
      /* If the module name was OK, then set the */
      /* current module to the specified module. */
      /*=========================================*/

      SavePPBuffer(theEnv," ");
      EnvSetCurrentModule(theEnv,(void *) theModule);
     }

   /*===========================================*/
   /* If the module name wasn't specified, then */
   /* use the current module's name in the      */
   /* defglobal's pretty print representation.  */
   /*===========================================*/

   else
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv))));
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,theToken.printForm);
     }

   /*======================*/
   /* Parse the variables. */
   /*======================*/

   while (GetVariableDefinition(theEnv,readSource,&defglobalError,tokenRead,&theToken))
     {
      tokenRead = FALSE;

      FlushPPBuffer(theEnv);
      SavePPBuffer(theEnv,"(defglobal ");
      SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv))));
      SavePPBuffer(theEnv," ");
     }

#endif

   /*==================================*/
   /* Return the parsing error status. */
   /*==================================*/

   return(defglobalError);
  }
Ejemplo n.º 28
0
static int ParseImportSpec(
  void *theEnv,
  char *readSource,
  struct token *theToken,
  struct defmodule *newModule)
  {
   struct defmodule *theModule;
   struct portItem *thePort, *oldImportSpec;
   int found, count;

   /*===========================*/
   /* Look for the module name. */
   /*===========================*/

   SavePPBuffer(theEnv," ");

   GetToken(theEnv,readSource,theToken);

   if (theToken->type != SYMBOL)
     {
      SyntaxErrorMessage(theEnv,"defmodule import specification");
      return(TRUE);
     }

   /*=====================================*/
   /* Verify the existence of the module. */
   /*=====================================*/

   if ((theModule = (struct defmodule *)
                    EnvFindDefmodule(theEnv,ValueToString(theToken->value))) == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken->value));
      return(TRUE);
     }

   /*========================================*/
   /* If the specified module doesn't export */
   /* any constructs, then the import        */
   /* specification is meaningless.          */
   /*========================================*/

   if (theModule->exportList == NULL)
     {
      NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),NULL,NULL);
      return(TRUE);
     }

   /*==============================================*/
   /* Parse the remaining portion of the import    */
   /* specification and return if an error occurs. */
   /*==============================================*/

   oldImportSpec = newModule->importList;
   if (ParseExportSpec(theEnv,readSource,theToken,newModule,theModule)) return(TRUE);

   /*========================================================*/
   /* If the ?NONE keyword was used with the import spec,    */
   /* then no constructs were actually imported and the      */
   /* import spec does not need to be checked for conflicts. */
   /*========================================================*/

   if (newModule->importList == oldImportSpec) return(FALSE);

   /*======================================================*/
   /* Check to see if the construct being imported can be  */
   /* by the specified module. This check exported doesn't */
   /* guarantee that a specific named construct actually   */
   /* exists. It just checks that it could be exported if  */
   /* it does exists.                                      */
   /*======================================================*/

   if (newModule->importList->constructType != NULL)
     {
      /*=============================*/
      /* Look for the construct in   */
      /* the module that exports it. */
      /*=============================*/

      found = FALSE;
      for (thePort = theModule->exportList;
           (thePort != NULL) && (! found);
           thePort = thePort->next)
        {
         if (thePort->constructType == NULL) found = TRUE;
         else if (thePort->constructType == newModule->importList->constructType)
           {
            if (newModule->importList->constructName == NULL) found = TRUE;
            else if (thePort->constructName == NULL) found = TRUE;
            else if (thePort->constructName == newModule->importList->constructName)
              { found = TRUE; }
           }
        }

      /*=======================================*/
      /* If it's not exported by the specified */
      /* module, print an error message.       */
      /*=======================================*/

      if (! found)
        {
         if (newModule->importList->constructName == NULL)
           {
            NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
                                    ValueToString(newModule->importList->constructType),
                                    NULL);
           }
         else
           {
            NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
                                    ValueToString(newModule->importList->constructType),
                                    ValueToString(newModule->importList->constructName));
           }
         return(TRUE);
        }
     }

   /*======================================================*/
   /* Verify that specific named constructs actually exist */
   /* and can be seen from the module importing them.      */
   /*======================================================*/

   SaveCurrentModule(theEnv);
   EnvSetCurrentModule(theEnv,(void *) newModule);

   for (thePort = newModule->importList;
        thePort != NULL;
        thePort = thePort->next)
     {
      if ((thePort->constructType == NULL) || (thePort->constructName == NULL))
        { continue; }

      theModule = (struct defmodule *)
                  EnvFindDefmodule(theEnv,ValueToString(thePort->moduleName));
      EnvSetCurrentModule(theEnv,theModule);
      if (FindImportedConstruct(theEnv,ValueToString(thePort->constructType),NULL,
                                ValueToString(thePort->constructName),&count,
                                TRUE,FALSE) == NULL)
        {
         NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
                                 ValueToString(thePort->constructType),
                                 ValueToString(thePort->constructName));
         RestoreCurrentModule(theEnv);
         return(TRUE);
        }
     }

   RestoreCurrentModule(theEnv);

   /*===============================================*/
   /* The import list has been successfully parsed. */
   /*===============================================*/

   return(FALSE);
  }
Ejemplo n.º 29
0
void *GetFactOrInstanceArgument(
  void *theEnv,
  int thePosition,
  DATA_OBJECT *item,
  char *functionName)
  {
#if DEFTEMPLATE_CONSTRUCT || OBJECT_SYSTEM
   void *ptr;
#endif

   /*==============================*/
   /* Retrieve the first argument. */
   /*==============================*/

   EnvRtnUnknown(theEnv,thePosition,item);

   /*==================================================*/
   /* Fact and instance addresses are valid arguments. */
   /*==================================================*/

   if ((GetpType(item) == FACT_ADDRESS) ||
       (GetpType(item) == INSTANCE_ADDRESS))
     { return(GetpValue(item)); }

   /*==================================================*/
   /* An integer is a valid argument if it corresponds */
   /* to the fact index of an existing fact.           */
   /*==================================================*/

#if DEFTEMPLATE_CONSTRUCT
   else if (GetpType(item) == INTEGER)
     {
      if ((ptr = (void *) FindIndexedFact(theEnv,DOPToLong(item))) == NULL)
        {
         char tempBuffer[20];
         sprintf(tempBuffer,"f-%ld",DOPToLong(item));
         CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
        }
      return(ptr);
     }
#endif

   /*================================================*/
   /* Instance names and symbols are valid arguments */
   /* if they correspond to an existing instance.    */
   /*================================================*/

#if OBJECT_SYSTEM
   else if ((GetpType(item) == INSTANCE_NAME) || (GetpType(item) == SYMBOL))
     {
      if ((ptr = (void *) FindInstanceBySymbol(theEnv,(SYMBOL_HN *) GetpValue(item))) == NULL)
        {
         CantFindItemErrorMessage(theEnv,"instance",ValueToString(GetpValue(item)));
        }
      return(ptr);
     }
#endif

   /*========================================*/
   /* Any other type is an invalid argument. */
   /*========================================*/

   ExpectedTypeError2(theEnv,functionName,thePosition);
   return(NULL);
  }