defins.c

clips源代码

globle int EnvIsDefinstancesDeletable(
  void *theEnv,
  void *ptr)
  {
   if (! ConstructsDeletable(theEnv))
     { return FALSE; }

   return((((DEFINSTANCES *) ptr)->busy == 0) ? TRUE : FALSE);
  }

/***********************************************************
  NAME         : UndefinstancesCommand
  DESCRIPTION  : Removes a definstance
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Definstance deallocated
  NOTES        : H/L Syntax : (undefinstances <name> | *)
 ***********************************************************/
globle void UndefinstancesCommand(
  void *theEnv)
  {
   UndefconstructCommand(theEnv,"undefinstances",DefinstancesData(theEnv)->DefinstancesConstruct);
  }

/*****************************************************************
  NAME         : GetDefinstancesModuleCommand
  DESCRIPTION  : Determines to which module a definstances belongs
  INPUTS       : None
  RETURNS      : The symbolic name of the module
  SIDE EFFECTS : None
  NOTES        : H/L Syntax: (definstances-module <defins-name>)
 *****************************************************************/
globle void *GetDefinstancesModuleCommand(
  void *theEnv)
  {
   return(GetConstructModuleCommand(theEnv,"definstances-module",DefinstancesData(theEnv)->DefinstancesConstruct));
  }

/***********************************************************
  NAME         : EnvUndefinstances
  DESCRIPTION  : Removes a definstance
  INPUTS       : Address of definstances to remove
  RETURNS      : TRUE if successful,
                 FALSE otherwise
  SIDE EFFECTS : Definstance deallocated
  NOTES        : None
 ***********************************************************/
globle intBool EnvUndefinstances(
  void *theEnv,
  void *vptr)
  {
#if RUN_TIME || BLOAD_ONLY
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv,vptr)
#endif
   return(FALSE);
#else
   DEFINSTANCES *dptr;

   dptr = (DEFINSTANCES *) vptr;

#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv))
     return(FALSE);
#endif
   if (dptr == NULL)
     return(RemoveAllDefinstances(theEnv));
   if (EnvIsDefinstancesDeletable(theEnv,vptr) == FALSE)
     return(FALSE);
   RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr);
   RemoveDefinstances(theEnv,(void *) dptr);
   return(TRUE);
#endif
  }

#if DEBUGGING_FUNCTIONS

/***************************************************************
  NAME         : PPDefinstancesCommand
  DESCRIPTION  : Prints out the pretty-print form of a definstance
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : H/L Syntax : (ppdefinstances <name>)
 ***************************************************************/
globle void PPDefinstancesCommand(
  void *theEnv)
  {
   PPConstructCommand(theEnv,"ppdefinstances",DefinstancesData(theEnv)->DefinstancesConstruct);
  }

/***************************************************
  NAME         : ListDefinstancesCommand
  DESCRIPTION  : Displays all definstances names
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Definstances name sprinted
  NOTES        : H/L Interface
 ***************************************************/
globle void ListDefinstancesCommand(
  void *theEnv)
  {
   ListConstructCommand(theEnv,"list-definstances",DefinstancesData(theEnv)->DefinstancesConstruct);
  }

/***************************************************
  NAME         : EnvListDefinstances
  DESCRIPTION  : Displays all definstances names
  INPUTS       : 1) The logical name of the output
                 2) The module
  RETURNS      : Nothing useful
  SIDE EFFECTS : Definstances names printed
  NOTES        : C Interface
 ***************************************************/
globle void EnvListDefinstances(
  void *theEnv,
  char *logicalName,
  struct defmodule *theModule)
  {
   ListConstruct(theEnv,DefinstancesData(theEnv)->DefinstancesConstruct,logicalName,theModule);
  }

#endif

/****************************************************************
  NAME         : GetDefinstancesListFunction
  DESCRIPTION  : Groups all definstances names into
                 a multifield list
  INPUTS       : A data object buffer to hold
                 the multifield result
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield allocated and filled
  NOTES        : H/L Syntax: (get-definstances-list [<module>])
 ****************************************************************/
globle void GetDefinstancesListFunction(
  void *theEnv,
  DATA_OBJECT*returnValue)
  {
   GetConstructListFunction(theEnv,"get-definstances-list",returnValue,DefinstancesData(theEnv)->DefinstancesConstruct);
  }

/***************************************************************
  NAME         : EnvGetDefinstancesList
  DESCRIPTION  : Groups all definstances names into
                 a multifield list
  INPUTS       : 1) A data object buffer to hold
                    the multifield result
                 2) The module from which to obtain definstances
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield allocated and filled
  NOTES        : External C access
 ***************************************************************/
globle void EnvGetDefinstancesList(
  void *theEnv,
  DATA_OBJECT *returnValue,
  struct defmodule *theModule)
  {
   GetConstructList(theEnv,returnValue,DefinstancesData(theEnv)->DefinstancesConstruct,theModule);
  }

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

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

/*********************************************************************
  NAME         : ParseDefinstances
  DESCRIPTION  : Parses and allocates a definstances construct
  INPUTS       : The logical name of the input source
  RETURNS      : FALSE if no errors, TRUE otherwise
  SIDE EFFECTS : Definstances parsed and created
  NOTES        : H/L Syntax :

                 (definstances  <name> [active] [<comment>]
                    <instance-definition>+)

                 <instance-definition> ::=
                    (<instance-name> of <class-name> <slot-override>*)

                 <slot-override> ::= (<slot-name> <value-expression>*)
 *********************************************************************/
static int ParseDefinstances(
  void *theEnv,
  char *readSource)
  {
   SYMBOL_HN *dname;
   void *mkinsfcall;
   EXPRESSION *mkinstance,*mkbot = NULL;
   DEFINSTANCES *dobj;
   int active;

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

#if BLOAD || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"definstances");
      return(TRUE);
     }
#endif
   dname = ParseDefinstancesName(theEnv,readSource,&active);
   if (dname == NULL)
     return(TRUE);

   dobj = get_struct(theEnv,definstances);
   InitializeConstructHeader(theEnv,"definstances",(struct constructHeader *) dobj,dname);
   dobj->busy = 0;
   dobj->mkinstance = NULL;
#if DEFRULE_CONSTRUCT
   mkinsfcall = (void *) FindFunction(theEnv,(char *) (active ? "active-make-instance" : "make-instance"));
#else
   mkinsfcall = (void *) FindFunction(theEnv,"make-instance");
#endif
   while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN)
     {
      mkinstance = GenConstant(theEnv,UNKNOWN_VALUE,mkinsfcall);
      mkinstance = ParseInitializeInstance(theEnv,mkinstance,readSource);
      if (mkinstance == NULL)
        {
         ReturnExpression(theEnv,dobj->mkinstance);
         rtn_struct(theEnv,definstances,dobj);
         return(TRUE);
        }
      if (ExpressionContainsVariables(mkinstance,FALSE) == TRUE)
        {
         LocalVariableErrorMessage(theEnv,"definstances");
         ReturnExpression(theEnv,mkinstance);
         ReturnExpression(theEnv,dobj->mkinstance);
         rtn_struct(theEnv,definstances,dobj);
         return(TRUE);
        }
      if (mkbot == NULL)
        dobj->mkinstance = mkinstance;
      else
        GetNextArgument(mkbot) = mkinstance;
      mkbot = mkinstance;
      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
      PPBackup(theEnv);
      PPCRAndIndent(theEnv);
      SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
     }

   if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
     {
      ReturnExpression(theEnv,dobj->mkinstance);
      rtn_struct(theEnv,definstances,dobj);
      SyntaxErrorMessage(theEnv,"definstances");
      return(TRUE);
     }
   else
     {
      if (ConstructData(theEnv)->CheckSyntaxMode)
        {
         ReturnExpression(theEnv,dobj->mkinstance);
         rtn_struct(theEnv,definstances,dobj);
         return(FALSE);
        }
#if DEBUGGING_FUNCTIONS
      if (EnvGetConserveMemory(theEnv) == FALSE)
        {
         if (dobj->mkinstance != NULL)
           PPBackup(theEnv);
         PPBackup(theEnv);
         SavePPBuffer(theEnv,")\n");
         SetDefinstancesPPForm((void *) dobj,CopyPPBuffer(theEnv));
        }
#endif
      mkinstance = dobj->mkinstance;
      dobj->mkinstance = PackExpression(theEnv,mkinstance);
      ReturnExpression(theEnv,mkinstance);
      IncrementSymbolCount(GetDefinstancesNamePointer((void *) dobj));
      ExpressionInstall(theEnv,dobj->mkinstance);
     }

   AddConstructToModule((struct constructHeader *) dobj);
   return(FALSE);
  }

/*************************************************************
  NAME         : ParseDefinstancesName
  DESCRIPTION  : Parses definstance name and optional comment
                 and optional "active" keyword
  INPUTS       : 1) The logical name of the input source
                 2) Buffer to hold flag indicating if
                    definstances should cause pattern-matching
                    to occur during slot-overrides
  RETURNS      : Address of name symbol, or
                   NULL if there was an error
  SIDE EFFECTS : Token after name or comment is scanned
  NOTES        : Assumes "(definstances" has already
                   been scanned.
 *************************************************************/
static SYMBOL_HN *ParseDefinstancesName(
  void *theEnv,
  char *readSource,
  int *active)
  {
   SYMBOL_HN *dname;

   *active = FALSE;
   dname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"definstances",
                                      EnvFindDefinstances,EnvUndefinstances,"@",
                                      TRUE,FALSE,TRUE);
   if (dname == NULL)
     return(NULL);

#if DEFRULE_CONSTRUCT
   if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? FALSE :
       (strcmp(ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken)),ACTIVE_RLN) == 0))
     {